4.5.1 Seasonal plot: weekly arrivals

ggseasonplot(GLWST_training_w.ts , year.labels=TRUE, year.labels.left=TRUE) +
  ylab("arrivals") +
  ggtitle("GLWST Seasonal plot: weekly arrivals")

ggseasonplot(MLKEP_training_w.ts , year.labels=TRUE, year.labels.left=TRUE) +
  ylab("arrivals") +
  ggtitle("MLKEP Seasonal plot: weekly arrivals")

ggseasonplot(WARUK_training_w.ts , year.labels=TRUE, year.labels.left=TRUE) +
  ylab("arrivals") +
  ggtitle("WARUK Seasonal plot: weekly arrivals")

Observations

• we see the lower demand at the 2008 year end and beginning of 2009 for all three hotels

4.6.1 correlogram and lag plot

gglagplot(GLWST_training_m.ts,main = "GLWST Lagged scatterplots for monthly bookings.")

## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?

gglagplot(MLKEP_training_m.ts,main = "MLKEP Lagged scatterplots for monthly bookings.")

## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?

gglagplot(WARUK_training_m.ts,main = "WARUK Lagged scatterplots for monthly bookings.")

## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?
## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?

ggAcf(GLWST_training_m.ts,main = "GLWST monthly bookings Time Series ACF")

## Warning: Ignoring unknown parameters: main

ggAcf(MLKEP_training_m.ts,main = "MLKEP monthly bookings Time Series ACF")

## Warning: Ignoring unknown parameters: main

ggAcf(WARUK_training_m.ts,main = "WARUK monthly bookings Time Series ACF")

## Warning: Ignoring unknown parameters: main

4.6.2 Seasonal plot: monthly arrivals

ggseasonplot(GLWST_training_m.ts , year.labels=TRUE, year.labels.left=TRUE) +
  ylab("arrivals") +
  ggtitle("GLWST Seasonal plot: monthly arrivals")

ggseasonplot(MLKEP_training_m.ts , year.labels=TRUE, year.labels.left=TRUE) +
  ylab("arrivals") +
  ggtitle("MLKEP Seasonal plot: monthly arrivals")

ggseasonplot(WARUK_training_m.ts , year.labels=TRUE, year.labels.left=TRUE) +
  ylab("arrivals") +
  ggtitle("WARUK Seasonal plot: monthly arrivals")

Observations

• for hotel GLWST, the overlapped parts (May - October) show are similar demands for 2008 and 2009, however, for hotel MLKEP, compared to year 2008, there are higher demands in May, June, July and August in 2009 and lower demands in September and October in 2009

• for hotel WARUK, the demands from May to October are lower in 2009 than 2008

4.6.3 plot by yearmonth by hotel

p1 <- training_data %>% mutate(month = as.factor(month(month,label=TRUE))) %>%
  group_by(hotel, month) %>% 
  summarise(arrivals = mean(final_arrivals)) %>%
  ggplot(aes(month, arrivals, fill = month)) +
  geom_col() +
  theme(legend.position = "none", axis.text.x  = element_text(angle=60, hjust=1, vjust=0.9)) +
  labs(title = "Average bookings by month by hotel", x = "Month of the year", y = "Average arrivals") + 
    facet_wrap(~ hotel)
p1

Observations

• there is less variations in hotel GLWST’s monthly demands, January has the lowest bookings

• for hotel MLKEP, January also has the lowest bookings, the most bookings are in September 2008 and June 2009

• for hotel WARUK, January has the lowest bookings

6.1.1 in sample data set

### model1: simple mean additive and multiplicative model by days prior
training_dataset <- training_data %>%
  mutate(month = month(month)) %>%
  group_by(hotel,days_prior) %>% 
  mutate (avg_add = mean(add),  # average remaining bookings by hotel and days prior
          avg_rate = mean(rate), # average daily rate by hotel and days prior
          fc_add = (cum_bookings + avg_add), # forecast using additive method by hotel and days prior
          fc_mul = (cum_bookings/avg_rate)) %>% ungroup() %>%  #forecast using multiplicative method by hotel and days prior
 
 ###  model2: simple mean additive and multiplicative model by days prior and month
  group_by(hotel,days_prior,month) %>% 
  mutate (avg_add_m = mean(add),  # average remaining bookings by hoteland days prior
          avg_rate_m = mean(rate), # average monthly rate by hotel and days prior
          fc_add_m = (cum_bookings + avg_add_m),  # forecast using additive method by hotel, days prior and month
          fc_mul_m = (cum_bookings/avg_rate_m))  %>% ungroup() %>% # forecast using multiplicative method by hotel, days prior and month

 ###  model3: simple mean additive and multiplicative model by days prior and DOW
  group_by(hotel,days_prior,DOW) %>% 
  mutate (avg_add_DOW = mean(add),   # average remaining bookings by hotel, days prior and DOW
          avg_rate_DOW = mean(rate), # average rate by hotel, days prior and DOW
          fc_add_DOW = (cum_bookings + avg_add_DOW),  # forecast using additive method by hotel, days prior and DOW
          fc_mul_DOW = (cum_bookings/avg_rate_DOW)) %>% ungroup() %>% # forecast using multiplicative method by hotel, days prior and DOW

 ###  model4: simple mean additive and multiplicative model by days prior , month and DOW
  group_by(hotel,days_prior,month,DOW) %>% 
  mutate (avg_add_mDOW = mean(add),   # average remaining bookings by hotel, days prior, month and DOW
          avg_rate_mDOW = mean(rate), # average rate by hotel, days prior, month and DOW
          fc_add_mDOW = (cum_bookings + avg_add_mDOW),  # forecast using additive method by hotel, days prior, month and DOW
          fc_mul_mDOW = (cum_bookings/avg_rate_mDOW)) %>% ungroup() # forecast using multiplicative method by hotel, days prior, month and DOW

6.1.2 out of sample data set

### merge with the naive forecast data
naive_data <- training_dataset %>% filter(days_prior == 0) %>%
  select(hotel,stay_date,final_arrivals) %>% 
  dplyr::rename(fc_naive= final_arrivals,naive_date = stay_date) 

sta_data_add <- training_dataset %>% select(c(hotel,days_prior,avg_add))  %>% distinct()
sta_data_mul <- training_dataset %>% select(c(hotel,days_prior,avg_rate))  %>% distinct()

sta_data_add_m <- training_dataset %>% select(c(hotel,days_prior,month,avg_add_m))  %>% distinct()
sta_data_mul_m <- training_dataset %>% select(c(hotel,days_prior,month,avg_rate_m))  %>% distinct()

sta_data_add_DOW <- training_dataset %>% select(c(hotel,days_prior,DOW,avg_add_DOW))  %>% distinct()
sta_data_mul_DOW <- training_dataset %>% select(c(hotel,days_prior,DOW,avg_rate_DOW))  %>% distinct()

sta_data_add_mDOW <- training_dataset %>% select(c(hotel,days_prior,month,DOW,avg_add_mDOW))  %>% distinct()
sta_data_mul_mDOW <- training_dataset %>% select(c(hotel,days_prior,month,DOW,avg_rate_mDOW))  %>% distinct()


valid_dataset <- test_data %>% 
  mutate(naive_date = stay_date - 364, month = month(month)) %>% # create a naive_date column for merge
  left_join(naive_data,by = c("hotel","naive_date"),copy = TRUE)  %>% # find only stay date from training dateset that exist in test dataset
  
  # add average remaining bookings by hotel and days prior to valid dataset
  left_join(sta_data_add,by= c("hotel","days_prior")) %>% 
  # add average rate by hotel and days prior to valid dataset
  left_join(sta_data_mul,by= c("hotel","days_prior")) %>% 
  
  # add average remaining bookings by hotel, days prior and month to valid dataset
  left_join(sta_data_add_m,by= c("hotel","days_prior","month")) %>% 
  # add average rate by hotel, days prior and month to valid dataset
  left_join(sta_data_mul_m,by= c("hotel","days_prior","month")) %>% 
  
  # add average remaining bookings by hotel, days prior and DOW to valid dataset
  left_join(sta_data_add_DOW,by= c("hotel","days_prior","DOW")) %>% 
  # add average rate bookings by hotel, days prior and DOW to valid dataset
  left_join(sta_data_mul_DOW,by= c("hotel","days_prior","DOW")) %>% 
  
  # add average remaining bookings by hotel, days prior, month and DOW to valid dataset
  left_join(sta_data_add_mDOW,by= c("hotel","days_prior","month","DOW")) %>% 
  # add average rate bookings by hotel, days prior, month and DOW to valid dataset
  left_join(sta_data_mul_mDOW,by= c("hotel","days_prior","month","DOW")) %>% 

  # forecast using additive and multiplicative method by hotel and days prior
  mutate(fc_add = (cum_bookings + avg_add), fc_mul = (cum_bookings/avg_rate)) %>% 
  # forecast using additive and multiplicative method by hotel, days prior and month
  mutate(fc_add_m = (cum_bookings + avg_add_m), fc_mul_m = (cum_bookings/avg_rate_m))%>% 
  # forecast using additive and multiplicative method by hotel, days prior and DOW
  mutate(fc_add_DOW = (cum_bookings + avg_add_DOW), fc_mul_DOW = (cum_bookings/avg_rate_DOW)) %>% 
  # forecast using additive and multiplicative method by hotel, days prior, month and DOW
  mutate(fc_add_mDOW = (cum_bookings + avg_add_mDOW), fc_mul_mDOW = (cum_bookings/avg_rate_mDOW))

6.3.1 define error matrix results function

###in sample
error_result_matrix <- function(train_dataset,test_dataset,hotelname, factorname) { 
  error_matrix_in <- train_dataset %>% 
  group_by_(hotelname,factorname)  %>% 
            # MAE error measurements
  summarise(MAE_add = sum(error_add)/n(),
            MAE_mul = sum(error_mul)/n(),
            MAE_add_m = sum(error_add_m)/n(),
            MAE_mul_m = sum(error_mul_m)/n(),
            MAE_add_DOW = sum(error_add_DOW)/n(),
            MAE_mul_DOW = sum(error_mul_DOW)/n(),
            MAE_add_mDOW = sum(error_add_mDOW)/n(),
            MAE_mul_mDOW = sum(error_mul_mDOW)/n(),
            # MAPE error measurements
            MAPE_add = sum((error_add)/final_arrivals)/n(),
            MAPE_mul = sum((error_mul)/final_arrivals)/n(),
            MAPE_add_m = sum((error_add_m)/final_arrivals)/n(),
            MAPE_mul_m = sum((error_mul_m)/final_arrivals)/n(),
            MAPE_add_DOW = sum((error_add_DOW)/final_arrivals)/n(),
            MAPE_mul_DOW = sum((error_mul_DOW)/final_arrivals)/n(),
            MAPE_add_mDOW = sum((error_add_mDOW)/final_arrivals)/n(),
            MAPE_mul_mDOW = sum((error_mul_mDOW)/final_arrivals)/n()) 
     
  error_matrix_in[factorname] <- paste(error_matrix_in[[factorname]], "in",sep = "_")

###out sample
  error_matrix_out <- test_dataset %>% 
    na.omit() %>%  # Drop NA forecast results in test data due to lack of reference in training data
  group_by_(hotelname,factorname)  %>%
           # MAE error measurements
  summarise(MAE_naive = sum(error_naive)/n(),
            MAE_add = sum(error_add)/n(),
            MAE_mul = sum(error_mul)/n(),
            MAE_add_m = sum(error_add_m)/n(),
            MAE_mul_m = sum(error_mul_m)/n(),
            MAE_add_DOW = sum(error_add_DOW)/n(),
            MAE_mul_DOW = sum(error_mul_DOW)/n(),
            MAE_add_mDOW = sum(error_add_mDOW)/n(),
            MAE_mul_mDOW = sum(error_mul_mDOW)/n(),
            # MAPE error measurements
            MAPE_naive = sum((error_naive)/final_arrivals)/n(),
            MAPE_add = sum((error_add)/final_arrivals)/n(),
            MAPE_mul = sum((error_mul)/final_arrivals)/n(),
            MAPE_add_m = sum((error_add_m)/final_arrivals)/n(),
            MAPE_mul_m = sum((error_mul_m)/final_arrivals)/n(),
            MAPE_add_DOW = sum((error_add_DOW)/final_arrivals)/n(),
            MAPE_mul_DOW = sum((error_mul_DOW)/final_arrivals)/n(),
            MAPE_add_mDOW = sum((error_add_mDOW)/final_arrivals)/n(),
            MAPE_mul_mDOW = sum((error_mul_mDOW)/final_arrivals)/n(),
            # MASE error measurements compared to naive model
            MASE_add = sum(error_add)/sum(error_naive),
            MASE_mul = sum(error_mul)/sum(error_naive),
            MASE_add_m = sum(error_add_m)/sum(error_naive),
            MASE_mul_m = sum(error_mul_m)/sum(error_naive),
            MASE_add_DOW = sum(error_add_DOW)/sum(error_naive),
            MASE_mul_DOW = sum(error_mul_DOW)/sum(error_naive),
            MASE_add_mDOW = sum(error_add_mDOW)/sum(error_naive),
            MASE_mul_mDOW = sum(error_mul_mDOW)/sum(error_naive)) 
   
  error_matrix_out[factorname] <- paste(error_matrix_out[[factorname]], "out",sep = "_")
          
  result<- rbind(error_matrix_in,error_matrix_out) 
  return(result)
}

6.3.2 final result for 3 hotel for 9 models by 3 error measuremeants

### aggreage result by hotel and days prior category

result_daysprior <- error_result_matrix(fc_result_in,fc_result_out, "hotel","days_prior_c") 

## Warning: group_by_() is deprecated. 
## Please use group_by() instead
## 
## The 'programming' vignette or the tidyeval book can help you
## to program with group_by() : https://tidyeval.tidyverse.org
## This warning is displayed once per session.

result_daysprior

## # A tibble: 36 x 28
## # Groups:   hotel [3]
##    hotel days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW
##    <fct> <chr>          <dbl>   <dbl>     <dbl>     <dbl>       <dbl>
##  1 GLWST 1 to 7_in       9.27    13.1      8.95      12.6        8.73
##  2 GLWST 15 to 21_in    15.4     32.4     14.8       29.9       13.9 
##  3 GLWST 22 to 28_in    16.4     38.7     15.6       35.9       14.8 
##  4 GLWST 29 to 60_in    17.5     53.8     16.3       48.3       15.6 
##  5 GLWST 60 or more_…   17.0    109.      16.0       80.8       15.1 
##  6 GLWST 8 to 14_in     14.4     26.2     13.8       24.5       13.0 
##  7 MLKEP 1 to 7_in      15.5     12.6     14.4       11.7       10.4 
##  8 MLKEP 15 to 21_in    34.8     40.0     33.3       35.8       20.8 
##  9 MLKEP 22 to 28_in    36.8     48.6     35.3       43.5       22.0 
## 10 MLKEP 29 to 60_in    38.7     67.8     37.4       60.9       23.8 
## # … with 26 more rows, and 21 more variables: MAE_mul_DOW <dbl>,
## #   MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>, MAPE_add <dbl>,
## #   MAPE_mul <dbl>, MAPE_add_m <dbl>, MAPE_mul_m <dbl>,
## #   MAPE_add_DOW <dbl>, MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## #   MAPE_mul_mDOW <dbl>, MAE_naive <dbl>, MAPE_naive <dbl>,
## #   MASE_add <dbl>, MASE_mul <dbl>, MASE_add_m <dbl>, MASE_mul_m <dbl>,
## #   MASE_add_DOW <dbl>, MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## #   MASE_mul_mDOW <dbl>

### aggreage result by hotel and month

result_month <- error_result_matrix(fc_result_in,fc_result_out, "hotel", "month")
 
result_month

## # A tibble: 54 x 28
## # Groups:   hotel [3]
##    hotel month MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <fct> <chr>   <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 GLWST 1_in     25.7    40.2      19.7      34.6        23.8        39.6
##  2 GLWST 2_in     15.8    65.4      14.9      61.2        14.0        61.9
##  3 GLWST 3_in     15.7    64.9      11.2      54.1        13.9        61.4
##  4 GLWST 4_in     15.3    55.0      13.4      38.8        14.2        51.3
##  5 GLWST 5_in     16.5    61.0      16.4      61.8        15.2        59.4
##  6 GLWST 6_in     17.4   125.       17.2      87.5        15.4       115. 
##  7 GLWST 7_in     13.9    81.8      13.1      80.2        12.1        73.9
##  8 GLWST 8_in     17.2   185.       17.4      90.6        16.3       192. 
##  9 GLWST 9_in     18.0    57.0      17.5      54.6        14.5        56.6
## 10 GLWST 10_in    15.8    61.3      14.7      63.2        13.1        57.9
## # … with 44 more rows, and 20 more variables: MAE_add_mDOW <dbl>,
## #   MAE_mul_mDOW <dbl>, MAPE_add <dbl>, MAPE_mul <dbl>, MAPE_add_m <dbl>,
## #   MAPE_mul_m <dbl>, MAPE_add_DOW <dbl>, MAPE_mul_DOW <dbl>,
## #   MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>, MAE_naive <dbl>,
## #   MAPE_naive <dbl>, MASE_add <dbl>, MASE_mul <dbl>, MASE_add_m <dbl>,
## #   MASE_mul_m <dbl>, MASE_add_DOW <dbl>, MASE_mul_DOW <dbl>,
## #   MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>

### aggreage result by hotel and DOW


result_DOW <- error_result_matrix(fc_result_in,fc_result_out,"hotel", "DOW")

result_DOW

## # A tibble: 42 x 28
## # Groups:   hotel [3]
##    hotel DOW   MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <fct> <chr>   <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 GLWST Sun_…    21.5    89.0      21.3      64.8        17.5        74.2
##  2 GLWST Mon_…    17.8   102.       16.8      71.8        17.4        93.4
##  3 GLWST Tue_…    17.6    97.7      16.1      68.1        15.7        99.9
##  4 GLWST Wed_…    16.3    87.1      15.1      64.5        14.0        91.6
##  5 GLWST Thu_…    14.2    70.0      13.2      48.3        14.0        74.1
##  6 GLWST Fri_…    13.8    77.6      12.5      63.6        13.8        76.2
##  7 GLWST Sat_…    15.8    96.5      15.0      90.5        11.6        92.3
##  8 MLKEP Sun_…    45.1    29.9      43.9      26.9        14.1        24.4
##  9 MLKEP Mon_…    31.0    64.3      26.9      57.1        27.7        66.0
## 10 MLKEP Tue_…    46.8    77.1      43.2      71.7        26.4        62.1
## # … with 32 more rows, and 20 more variables: MAE_add_mDOW <dbl>,
## #   MAE_mul_mDOW <dbl>, MAPE_add <dbl>, MAPE_mul <dbl>, MAPE_add_m <dbl>,
## #   MAPE_mul_m <dbl>, MAPE_add_DOW <dbl>, MAPE_mul_DOW <dbl>,
## #   MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>, MAE_naive <dbl>,
## #   MAPE_naive <dbl>, MASE_add <dbl>, MASE_mul <dbl>, MASE_add_m <dbl>,
## #   MASE_mul_m <dbl>, MASE_add_DOW <dbl>, MASE_mul_DOW <dbl>,
## #   MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>

6.3.3 details of results by 3 hotels

result_DOW_G <- result_DOW %>% filter(hotel == "GLWST") %>% arrange(DOW) 

result_DOW_G_MAE <- result_DOW_G[names(result_DOW_G) %like% "MAE" | names(result_DOW_G) == "DOW"]
result_DOW_G_MAE

## # A tibble: 14 x 10
##    DOW   MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>   <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 Fri_…    13.8    77.6      12.5      63.6        13.8        76.2
##  2 Fri_…    14.7    43.3      14.1      73.8        14.5        40.4
##  3 Mon_…    17.8   102.       16.8      71.8        17.4        93.4
##  4 Mon_…    18.2    54.5      16.2      43.7        17.0        52.5
##  5 Sat_…    15.8    96.5      15.0      90.5        11.6        92.3
##  6 Sat_…    17.1    54.9      16.8      90.0        14.9        49.9
##  7 Sun_…    21.5    89.0      21.3      64.8        17.5        74.2
##  8 Sun_…    26.8    37.9      23.6      38.3        17.3        40.6
##  9 Thu_…    14.2    70.0      13.2      48.3        14.0        74.1
## 10 Thu_…    22.8    41.8      20.3      42.2        21.9        40.1
## 11 Tue_…    17.6    97.7      16.1      68.1        15.7        99.9
## 12 Tue_…    21.9    52.5      17.7      44.0        22.7        51.5
## 13 Wed_…    16.3    87.1      15.1      64.5        14.0        91.6
## 14 Wed_…    21.2    61.8      16.9      49.6        20.9        58.6
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_DOW_G_MAPE <- result_DOW_G[names(result_DOW_G) %like% "MAPE" | names(result_DOW_G) == "DOW"]
result_DOW_G_MAPE

## # A tibble: 14 x 10
##    DOW   MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 Fri_…    0.144    0.672      0.126      0.565        0.142        0.659
##  2 Fri_…    0.293    0.426      0.250      0.752        0.288        0.397
##  3 Mon_…    0.199    0.898      0.187      0.644        0.192        0.830
##  4 Mon_…    0.249    0.625      0.211      0.506        0.233        0.599
##  5 Sat_…    0.137    0.775      0.126      0.724        0.106        0.743
##  6 Sat_…    0.265    0.491      0.240      0.822        0.264        0.446
##  7 Sun_…    0.307    0.844      0.303      0.635        0.223        0.724
##  8 Sun_…    0.405    0.484      0.354      0.518        0.244        0.516
##  9 Thu_…    0.167    0.621      0.150      0.451        0.162        0.647
## 10 Thu_…    0.458    0.497      0.382      0.521        0.439        0.483
## 11 Tue_…    0.181    0.805      0.160      0.574        0.172        0.819
## 12 Tue_…    0.313    0.581      0.239      0.509        0.343        0.567
## 13 Wed_…    0.171    0.709      0.153      0.534        0.161        0.737
## 14 Wed_…    0.300    0.607      0.224      0.512        0.321        0.570
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## #   MAPE_naive <dbl>

result_DOW_G_MASE <- result_DOW_G[names(result_DOW_G) %like% "MASE" | names(result_DOW_G) == "DOW"]
result_DOW_G_MASE

## # A tibble: 14 x 9
##    DOW   MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 Fri_…   NA        NA        NA          NA          NA            NA   
##  2 Fri_…    0.894     2.64      0.862       4.50        0.882         2.46
##  3 Mon_…   NA        NA        NA          NA          NA            NA   
##  4 Mon_…    0.978     2.94      0.871       2.36        0.918         2.83
##  5 Sat_…   NA        NA        NA          NA          NA            NA   
##  6 Sat_…    1.20      3.84      1.17        6.29        1.04          3.49
##  7 Sun_…   NA        NA        NA          NA          NA            NA   
##  8 Sun_…    1.24      1.76      1.09        1.78        0.804         1.89
##  9 Thu_…   NA        NA        NA          NA          NA            NA   
## 10 Thu_…    1.12      2.06      1.00        2.08        1.08          1.98
## 11 Tue_…   NA        NA        NA          NA          NA            NA   
## 12 Tue_…    1.10      2.63      0.884       2.20        1.14          2.58
## 13 Wed_…   NA        NA        NA          NA          NA            NA   
## 14 Wed_…    0.899     2.62      0.715       2.10        0.885         2.48
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>

#Monthly
result_month_G <- result_month %>% filter(hotel == "GLWST") %>% arrange(month) 

result_month_G_MAE <- result_month_G[names(result_month_G) %like% "MAE" | names(result_month_G) == "month"]
result_month_G_MAE

## # A tibble: 18 x 10
##    month MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>   <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 1_in     25.7    40.2      19.7      34.6        23.8        39.6
##  2 1_out    30.4    31.0      19.5      47.4        29.5        29.0
##  3 10_in    15.8    61.3      14.7      63.2        13.1        57.9
##  4 11_in    14.0    51.6      13.5      55.9        11.7        49.2
##  5 11_o…    17.2    58.9      17.2      58.9        12.6        55.9
##  6 12_in    18.6    50.0      15.7      46.5        17.8        47.7
##  7 12_o…    26.5    41.7      23.0      37.0        25.2        39.1
##  8 2_in     15.8    65.4      14.9      61.2        14.0        61.9
##  9 2_out    17.1    50.0      18.2      78.8        14.8        48.2
## 10 3_in     15.7    64.9      11.2      54.1        13.9        61.4
## 11 3_out    14.4    53.8      13.4      65.3        12.2        54.7
## 12 4_in     15.3    55.0      13.4      38.8        14.2        51.3
## 13 4_out    15.0    57.8      14.8      62.2        14.3        55.2
## 14 5_in     16.5    61.0      16.4      61.8        15.2        59.4
## 15 6_in     17.4   125.       17.2      87.5        15.4       115. 
## 16 7_in     13.9    81.8      13.1      80.2        12.1        73.9
## 17 8_in     17.2   185.       17.4      90.6        16.3       192. 
## 18 9_in     18.0    57.0      17.5      54.6        14.5        56.6
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_month_G_MAPE <- result_month_G[names(result_month_G) %like% "MAPE" | names(result_month_G) == "month"]
result_month_G_MAPE

## # A tibble: 18 x 10
##    month MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 1_in     0.489    0.504      0.321      0.426        0.466        0.500
##  2 1_out    0.622    0.438      0.375      0.729        0.610        0.413
##  3 10_in    0.162    0.549      0.158      0.548        0.130        0.523
##  4 11_in    0.148    0.471      0.145      0.518        0.120        0.453
##  5 11_o…    0.191    0.566      0.194      0.556        0.135        0.542
##  6 12_in    0.368    0.522      0.283      0.487        0.371        0.507
##  7 12_o…    0.573    0.486      0.463      0.455        0.564        0.459
##  8 2_in     0.172    0.639      0.169      0.565        0.148        0.605
##  9 2_out    0.210    0.550      0.231      0.823        0.182        0.526
## 10 3_in     0.154    0.564      0.124      0.481        0.131        0.537
## 11 3_out    0.155    0.515      0.157      0.618        0.131        0.521
## 12 4_in     0.148    0.495      0.138      0.347        0.140        0.462
## 13 4_out    0.164    0.576      0.173      0.596        0.151        0.554
## 14 5_in     0.203    0.583      0.196      0.566        0.181        0.567
## 15 6_in     0.168    1.07       0.166      0.763        0.149        0.966
## 16 7_in     0.125    0.690      0.121      0.679        0.108        0.624
## 17 8_in     0.157    1.44       0.157      0.723        0.145        1.49 
## 18 9_in     0.190    0.508      0.190      0.476        0.150        0.504
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## #   MAPE_naive <dbl>

result_month_G_MASE <- result_month_G[names(result_month_G) %like% "MASE" | names(result_month_G) == "month"]
result_month_G_MASE

## # A tibble: 18 x 9
##    month MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 1_in    NA        NA        NA          NA          NA            NA   
##  2 1_out    1.86      1.89      1.19        2.90        1.80          1.77
##  3 10_in   NA        NA        NA          NA          NA            NA   
##  4 11_in   NA        NA        NA          NA          NA            NA   
##  5 11_o…    1.06      3.61      1.06        3.61        0.770         3.43
##  6 12_in   NA        NA        NA          NA          NA            NA   
##  7 12_o…    1.26      1.98      1.09        1.76        1.19          1.85
##  8 2_in    NA        NA        NA          NA          NA            NA   
##  9 2_out    1.43      4.18      1.52        6.59        1.23          4.03
## 10 3_in    NA        NA        NA          NA          NA            NA   
## 11 3_out    0.615     2.29      0.573       2.78        0.519         2.33
## 12 4_in    NA        NA        NA          NA          NA            NA   
## 13 4_out    0.670     2.59      0.663       2.78        0.639         2.47
## 14 5_in    NA        NA        NA          NA          NA            NA   
## 15 6_in    NA        NA        NA          NA          NA            NA   
## 16 7_in    NA        NA        NA          NA          NA            NA   
## 17 8_in    NA        NA        NA          NA          NA            NA   
## 18 9_in    NA        NA        NA          NA          NA            NA   
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>

#Days prior categories
result_daysprior_G <- result_daysprior %>% filter(hotel == "GLWST") %>% arrange(days_prior_c) 

result_daysprior_G_MAE <- result_daysprior_G[names(result_daysprior_G) %like% "MAE" | names(result_daysprior_G) == "days_prior_c"]
result_daysprior_G_MAE 

## # A tibble: 12 x 10
##    days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>          <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 1 to 7_in       9.27    13.1      8.95      12.6        8.73        12.1
##  2 1 to 7_out      9.20    13.1      8.81      13.3        8.60        11.6
##  3 15 to 21_in    15.4     32.4     14.8       29.9       13.9         29.3
##  4 15 to 21_out   16.6     35.4     15.0       34.8       15.3         31.5
##  5 22 to 28_in    16.4     38.7     15.6       35.9       14.8         36.1
##  6 22 to 28_out   17.6     39.6     15.3       40.6       16.3         34.8
##  7 29 to 60_in    17.5     53.8     16.3       48.3       15.6         51.0
##  8 29 to 60_out   20.0     45.0     16.9       45.6       18.5         41.6
##  9 60 or more_…   17.0    109.      16.0       80.8       15.1        107. 
## 10 60 or more_…   21.9     56.6     19.7       68.4       19.3         55.5
## 11 8 to 14_in     14.4     26.2     13.8       24.5       13.0         23.1
## 12 8 to 14_out    15.0     27.6     13.6       26.9       13.8         24.2
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_daysprior_G_MAPE <- result_daysprior_G[names(result_daysprior_G) %like% "MAPE" | names(result_daysprior_G) == "days_prior_c"]
result_daysprior_G_MAPE

## # A tibble: 12 x 10
##    days_prior_c MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW
##    <chr>           <dbl>    <dbl>      <dbl>      <dbl>        <dbl>
##  1 1 to 7_in       0.101    0.123     0.0954      0.120       0.0957
##  2 1 to 7_out      0.122    0.154     0.113       0.155       0.115 
##  3 15 to 21_in     0.180    0.302     0.167       0.280       0.164 
##  4 15 to 21_out    0.241    0.408     0.200       0.398       0.226 
##  5 22 to 28_in     0.194    0.360     0.178       0.332       0.177 
##  6 22 to 28_out    0.269    0.450     0.213       0.454       0.252 
##  7 29 to 60_in     0.214    0.489     0.191       0.442       0.191 
##  8 29 to 60_out    0.326    0.503     0.253       0.506       0.304 
##  9 60 or more_…    0.184    0.926     0.171       0.698       0.162 
## 10 60 or more_…    0.359    0.584     0.308       0.722       0.332 
## 11 8 to 14_in      0.162    0.243     0.152       0.229       0.149 
## 12 8 to 14_out     0.206    0.321     0.174       0.312       0.193 
## # … with 4 more variables: MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## #   MAPE_mul_mDOW <dbl>, MAPE_naive <dbl>

result_daysprior_G_MASE <- result_daysprior_G[names(result_daysprior_G) %like% "MASE" | names(result_daysprior_G) == "days_prior_c"]
result_daysprior_G_MASE

## # A tibble: 12 x 9
##    days_prior_c MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW
##    <chr>           <dbl>    <dbl>      <dbl>      <dbl>        <dbl>
##  1 1 to 7_in      NA       NA         NA         NA           NA    
##  2 1 to 7_out      0.470    0.670      0.450      0.677        0.439
##  3 15 to 21_in    NA       NA         NA         NA           NA    
##  4 15 to 21_out    0.847    1.81       0.767      1.78         0.784
##  5 22 to 28_in    NA       NA         NA         NA           NA    
##  6 22 to 28_out    0.895    2.02       0.780      2.07         0.832
##  7 29 to 60_in    NA       NA         NA         NA           NA    
##  8 29 to 60_out    1.03     2.32       0.868      2.35         0.952
##  9 60 or more_…   NA       NA         NA         NA           NA    
## 10 60 or more_…    1.18     3.04       1.06       3.67         1.04 
## 11 8 to 14_in     NA       NA         NA         NA           NA    
## 12 8 to 14_out     0.764    1.41       0.694      1.37         0.704
## # … with 3 more variables: MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## #   MASE_mul_mDOW <dbl>

#DOW
result_DOW_M <- result_DOW %>% filter(hotel == "MLKEP") %>% arrange(DOW) 

result_DOW_M_MAE <- result_DOW_M[names(result_DOW_M) %like% "MAE" | names(result_DOW_M) == "DOW"]
result_DOW_M_MAE

## # A tibble: 14 x 10
##    DOW   MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>   <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 Fri_…    38.9    56.3      36.6      45.2       19.7         37.5
##  2 Fri_…    40.9    28.5      45.6      52.6       11.6         24.2
##  3 Mon_…    31.0    64.3      26.9      57.1       27.7         66.0
##  4 Mon_…    34.1    62.3      28.8      51.7       27.5         52.5
##  5 Sat_…    27.7    83.7      26.1      69.3       26.1         63.4
##  6 Sat_…    27.3    49.5      28.3      75.7       23.6         42.3
##  7 Sun_…    45.1    29.9      43.9      26.9       14.1         24.4
##  8 Sun_…    44.0    17.6      46.6      17.1        8.67        18.6
##  9 Thu_…    24.9    52.8      21.9      46.0       24.5         54.8
## 10 Thu_…    24.4    59.6      22.1      58.8       25.3         60.3
## 11 Tue_…    46.8    77.1      43.2      71.7       26.4         62.1
## 12 Tue_…    59.2    82.9      53.9      72.2       34.3         61.2
## 13 Wed_…    41.6    83.7      39.0      73.1       25.9         85.9
## 14 Wed_…    57.9    83.5      54.2      82.9       34.6         75.4
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_DOW_M_MAPE <- result_DOW_M[names(result_DOW_M) %like% "MAPE" | names(result_DOW_M) == "DOW"]
result_DOW_M_MAPE 

## # A tibble: 14 x 10
##    DOW   MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 Fri_…    0.896    0.807      0.832      0.680        0.367        0.554
##  2 Fri_…    0.985    0.542      1.10       1.00         0.298        0.482
##  3 Mon_…    0.357    0.554      0.304      0.504        0.374        0.577
##  4 Mon_…    0.351    0.545      0.307      0.452        0.336        0.499
##  5 Sat_…    0.384    0.787      0.350      0.658        0.345        0.607
##  6 Sat_…    0.533    0.590      0.510      0.846        0.450        0.514
##  7 Sun_…    1.47     0.608      1.39       0.563        0.396        0.508
##  8 Sun_…    1.22     0.406      1.27       0.419        0.230        0.431
##  9 Thu_…    0.454    0.572      0.345      0.507        0.432        0.595
## 10 Thu_…    0.399    0.641      0.357      0.619        0.391        0.659
## 11 Tue_…    0.387    0.572      0.354      0.526        0.332        0.529
## 12 Tue_…    0.476    0.539      0.434      0.471        0.415        0.449
## 13 Wed_…    0.315    0.636      0.298      0.549        0.259        0.687
## 14 Wed_…    0.567    0.654      0.530      0.641        0.540        0.693
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## #   MAPE_naive <dbl>

result_DOW_M_MASE <- result_DOW_M[names(result_DOW_M) %like% "MASE" | names(result_DOW_M) == "DOW"]
result_DOW_M_MASE

## # A tibble: 14 x 9
##    DOW   MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 Fri_…   NA        NA        NA          NA          NA            NA   
##  2 Fri_…    3.75      2.62      4.19        4.82        1.07          2.22
##  3 Mon_…   NA        NA        NA          NA          NA            NA   
##  4 Mon_…    1.32      2.41      1.12        2.00        1.07          2.04
##  5 Sat_…   NA        NA        NA          NA          NA            NA   
##  6 Sat_…    1.46      2.64      1.51        4.04        1.26          2.26
##  7 Sun_…   NA        NA        NA          NA          NA            NA   
##  8 Sun_…    3.60      1.44      3.81        1.40        0.709         1.52
##  9 Thu_…   NA        NA        NA          NA          NA            NA   
## 10 Thu_…    0.837     2.05      0.760       2.02        0.869         2.07
## 11 Tue_…   NA        NA        NA          NA          NA            NA   
## 12 Tue_…    3.30      4.62      3.00        4.02        1.91          3.41
## 13 Wed_…   NA        NA        NA          NA          NA            NA   
## 14 Wed_…    2.83      4.08      2.65        4.05        1.69          3.68
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>

#Monthly
result_month_M <- result_month %>% filter(hotel == "MLKEP") %>% arrange(month) 

result_month_M_MAE <- result_month_M[names(result_month_M) %like% "MAE" | names(result_month_M) == "month"]
result_month_M_MAE

## # A tibble: 18 x 10
##    month MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>   <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 1_in     44.1    38.6      36.4      34.9        25.8        35.0
##  2 1_out    45.0    42.8      41.1      38.4        29.0        35.7
##  3 10_in    38.7    46.8      38.4      41.2        19.8        38.9
##  4 11_in    39.6    49.8      38.3      44.7        20.0        40.2
##  5 11_o…    42.3    64.9      40.9      51.6        23.5        59.1
##  6 12_in    49.7    56.0      46.4      51.7        39.6        56.8
##  7 12_o…    47.1    56.2      46.0      52.5        36.3        53.4
##  8 2_in     35.5    51.8      33.0      55.7        16.6        51.5
##  9 2_out    34.1    48.9      34.5      38.4        12.5        42.3
## 10 3_in     35.4    61.3      33.9      47.7        16.6        54.6
## 11 3_out    38.1    64.0      37.0     109.         19.7        54.0
## 12 4_in     38.6    55.6      37.4      56.0        19.3        50.8
## 13 4_out    38.4    45.4      39.0      47.3        19.9        35.4
## 14 5_in     36.2    68.1      31.0      53.4        27.9        53.5
## 15 6_in     37.8   100.       33.7      74.0        31.6        94.0
## 16 7_in     38.1    94.0      36.7      79.9        28.3        84.2
## 17 8_in     22.9    42.7      21.8      43.4        13.8        33.6
## 18 9_in     33.8    57.3      31.3      56.5        18.8        45.5
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_month_M_MAPE <- result_month_M[names(result_month_M) %like% "MAPE" | names(result_month_M) == "month"]
result_month_M_MAPE

## # A tibble: 18 x 10
##    month MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 1_in     1.46     0.506      0.938      0.509        1.02         0.537
##  2 1_out    0.983    0.459      0.819      0.473        0.583        0.413
##  3 10_in    0.544    0.454      0.554      0.447        0.238        0.415
##  4 11_in    0.502    0.430      0.546      0.431        0.208        0.390
##  5 11_o…    0.463    0.556      0.500      0.434        0.203        0.540
##  6 12_in    1.14     0.721      0.972      0.621        0.925        0.886
##  7 12_o…    0.954    0.754      0.881      0.675        0.872        0.831
##  8 2_in     0.557    0.531      0.535      0.586        0.223        0.539
##  9 2_out    0.479    0.490      0.525      0.392        0.156        0.468
## 10 3_in     0.415    0.535      0.463      0.441        0.162        0.498
## 11 3_out    0.486    0.570      0.553      1.16         0.215        0.485
## 12 4_in     0.628    0.562      0.613      0.558        0.295        0.501
## 13 4_out    0.561    0.474      0.574      0.528        0.272        0.390
## 14 5_in     0.751    0.747      0.558      0.586        0.508        0.572
## 15 6_in     0.573    0.860      0.538      0.626        0.404        0.799
## 16 7_in     0.514    1.04       0.543      0.821        0.328        0.858
## 17 8_in     0.390    0.486      0.328      0.510        0.190        0.399
## 18 9_in     0.375    0.504      0.396      0.524        0.181        0.404
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## #   MAPE_naive <dbl>

result_month_M_MASE <- result_month_M[names(result_month_M) %like% "MASE" | names(result_month_M) == "month"]
result_month_M_MASE

## # A tibble: 18 x 9
##    month MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 1_in     NA       NA         NA         NA          NA            NA   
##  2 1_out     2.80     2.67       2.56       2.39        1.81          2.22
##  3 10_in    NA       NA         NA         NA          NA            NA   
##  4 11_in    NA       NA         NA         NA          NA            NA   
##  5 11_o…     1.96     3.01       1.89       2.39        1.09          2.74
##  6 12_in    NA       NA         NA         NA          NA            NA   
##  7 12_o…     2.19     2.62       2.14       2.44        1.69          2.49
##  8 2_in     NA       NA         NA         NA          NA            NA   
##  9 2_out     2.33     3.33       2.35       2.62        0.849         2.89
## 10 3_in     NA       NA         NA         NA          NA            NA   
## 11 3_out     2.13     3.58       2.07       6.08        1.10          3.02
## 12 4_in     NA       NA         NA         NA          NA            NA   
## 13 4_out     1.77     2.10       1.80       2.18        0.918         1.63
## 14 5_in     NA       NA         NA         NA          NA            NA   
## 15 6_in     NA       NA         NA         NA          NA            NA   
## 16 7_in     NA       NA         NA         NA          NA            NA   
## 17 8_in     NA       NA         NA         NA          NA            NA   
## 18 9_in     NA       NA         NA         NA          NA            NA   
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>

#Days prior categories
result_daysprior_M <- result_daysprior %>% filter(hotel == "MLKEP") %>% arrange(days_prior_c) 

result_daysprior_M_MAE <- result_daysprior_M[names(result_daysprior_M) %like% "MAE" | names(result_daysprior_M) == "days_prior_c"]
result_daysprior_M_MAE

## # A tibble: 12 x 10
##    days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>          <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 1 to 7_in       15.5    12.6      14.4      11.7        10.4        11.6
##  2 1 to 7_out      17.5    13.2      17.5      13.1        11.0        12.0
##  3 15 to 21_in     34.8    40.0      33.3      35.8        20.8        33.1
##  4 15 to 21_out    39.9    41.8      39.2      44.0        21.7        33.8
##  5 22 to 28_in     36.8    48.6      35.3      43.5        22.0        40.4
##  6 22 to 28_out    42.3    52.8      41.5      56.1        22.8        43.5
##  7 29 to 60_in     38.7    67.8      37.4      60.9        23.8        56.2
##  8 29 to 60_out    44.0    66.0      43.5      71.2        24.3        56.5
##  9 60 or more_…    38.3    80.7      34.4      68.3        26.5        72.5
## 10 60 or more_…    44.8    64.2      42.9      73.0        28.1        58.3
## 11 8 to 14_in      30.7    29.3      29.0      25.9        18.7        24.7
## 12 8 to 14_out     34.3    28.5      33.8      28.9        18.7        23.8
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_daysprior_M_MAPE <- result_daysprior_M[names(result_daysprior_M) %like% "MAPE" | names(result_daysprior_M) == "days_prior_c"]
result_daysprior_M_MAPE

## # A tibble: 12 x 10
##    days_prior_c MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW
##    <chr>           <dbl>    <dbl>      <dbl>      <dbl>        <dbl>
##  1 1 to 7_in       0.258    0.142      0.237      0.129        0.155
##  2 1 to 7_out      0.254    0.137      0.263      0.135        0.150
##  3 15 to 21_in     0.598    0.433      0.565      0.391        0.321
##  4 15 to 21_out    0.608    0.421      0.612      0.445        0.325
##  5 22 to 28_in     0.635    0.522      0.602      0.479        0.341
##  6 22 to 28_out    0.629    0.533      0.635      0.561        0.337
##  7 29 to 60_in     0.646    0.714      0.622      0.651        0.360
##  8 29 to 60_out    0.670    0.676      0.684      0.736        0.375
##  9 60 or more_…    0.607    0.784      0.526      0.667        0.395
## 10 60 or more_…    0.749    0.660      0.716      0.854        0.503
## 11 8 to 14_in      0.519    0.319      0.486      0.283        0.283
## 12 8 to 14_out     0.525    0.291      0.532      0.299        0.281
## # … with 4 more variables: MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## #   MAPE_mul_mDOW <dbl>, MAPE_naive <dbl>

result_daysprior_M_MASE <- result_daysprior_M[names(result_daysprior_M) %like% "MASE" | names(result_daysprior_M) == "days_prior_c"]
result_daysprior_M_MASE

## # A tibble: 12 x 9
##    days_prior_c MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW
##    <chr>           <dbl>    <dbl>      <dbl>      <dbl>        <dbl>
##  1 1 to 7_in      NA       NA         NA         NA           NA    
##  2 1 to 7_out      0.934    0.701      0.931      0.695        0.585
##  3 15 to 21_in    NA       NA         NA         NA           NA    
##  4 15 to 21_out    2.13     2.22       2.09       2.34         1.15 
##  5 22 to 28_in    NA       NA         NA         NA           NA    
##  6 22 to 28_out    2.25     2.82       2.22       3.00         1.22 
##  7 29 to 60_in    NA       NA         NA         NA           NA    
##  8 29 to 60_out    2.32     3.48       2.29       3.75         1.28 
##  9 60 or more_…   NA       NA         NA         NA           NA    
## 10 60 or more_…    2.26     3.24       2.17       3.69         1.42 
## 11 8 to 14_in     NA       NA         NA         NA           NA    
## 12 8 to 14_out     1.83     1.52       1.80       1.54         0.995
## # … with 3 more variables: MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## #   MASE_mul_mDOW <dbl>

#DOW
result_DOW_W <- result_DOW %>% filter(hotel == "WARUK") %>% arrange(DOW) 

result_DOW_W_MAE <- result_DOW_W[names(result_DOW_W) %like% "MAE" | names(result_DOW_W) == "DOW"]
result_DOW_W_MAE 

## # A tibble: 14 x 10
##    DOW   MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>   <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 Fri_…    25.3    49.5      23.1      46.1        20.3        35.9
##  2 Fri_…    38.2    21.2      29.7      22.9        24.7        17.7
##  3 Mon_…    20.0    38.9      20.4      35.2        19.6        37.0
##  4 Mon_…    17.0    34.1      15.7      29.7        18.2        27.9
##  5 Sat_…    26.6    77.2      23.5      73.8        22.2        58.5
##  6 Sat_…    26.7    30.2      20.1      32.6        33.6        28.4
##  7 Sun_…    42.7    22.1      42.5      20.6        11.4        17.9
##  8 Sun_…    51.1    12.1      42.7      15.5        12.2        10.3
##  9 Thu_…    20.8    37.5      18.0      31.9        19.6        37.4
## 10 Thu_…    23.9    28.5      20.5      25.1        19.9        27.6
## 11 Tue_…    29.4    61.4      29.1      55.8        18.0        57.1
## 12 Tue_…    29.3    61.3      32.2      54.4        22.5        46.9
## 13 Wed_…    24.2    57.4      23.5      50.9        17.0        53.1
## 14 Wed_…    21.9    48.2      24.6      43.8        23.7        41.0
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_DOW_W_MAPE <- result_DOW_W[names(result_DOW_W) %like% "MAPE" | names(result_DOW_W) == "DOW"]
result_DOW_W_MAPE

## # A tibble: 14 x 10
##    DOW   MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW MAPE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 Fri_…    0.468    0.635      0.424      0.602        0.327        0.470
##  2 Fri_…    1.36     0.570      1.07       0.670        0.902        0.461
##  3 Mon_…    0.279    0.456      0.280      0.412        0.280        0.442
##  4 Mon_…    0.395    0.474      0.344      0.437        0.434        0.412
##  5 Sat_…    0.298    0.696      0.255      0.678        0.291        0.527
##  6 Sat_…    0.691    0.574      0.490      0.590        0.834        0.527
##  7 Sun_…    1.46     0.543      1.42       0.520        0.349        0.417
##  8 Sun_…    2.48     0.519      2.06       0.656        0.659        0.428
##  9 Thu_…    0.358    0.523      0.303      0.445        0.311        0.522
## 10 Thu_…    0.592    0.514      0.482      0.423        0.494        0.510
## 11 Tue_…    0.281    0.566      0.270      0.503        0.225        0.544
## 12 Tue_…    0.351    0.580      0.347      0.518        0.387        0.461
## 13 Wed_…    0.228    0.553      0.217      0.484        0.192        0.523
## 14 Wed_…    0.491    0.584      0.442      0.502        0.642        0.579
## # … with 3 more variables: MAPE_add_mDOW <dbl>, MAPE_mul_mDOW <dbl>,
## #   MAPE_naive <dbl>

result_DOW_W_MASE <- result_DOW_W[names(result_DOW_W) %like% "MASE" | names(result_DOW_W) == "DOW"]
result_DOW_W_MASE

## # A tibble: 14 x 9
##    DOW   MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW MASE_mul_DOW
##    <chr>    <dbl>    <dbl>      <dbl>      <dbl>        <dbl>        <dbl>
##  1 Fri_…   NA       NA         NA          NA          NA           NA    
##  2 Fri_…    1.75     0.974      1.36        1.05        1.14         0.815
##  3 Mon_…   NA       NA         NA          NA          NA           NA    
##  4 Mon_…    0.742    1.49       0.686       1.30        0.796        1.22 
##  5 Sat_…   NA       NA         NA          NA          NA           NA    
##  6 Sat_…    0.994    1.13       0.749       1.21        1.25         1.06 
##  7 Sun_…   NA       NA         NA          NA          NA           NA    
##  8 Sun_…    5.79     1.37       4.84        1.76        1.38         1.17 
##  9 Thu_…   NA       NA         NA          NA          NA           NA    
## 10 Thu_…    1.13     1.35       0.970       1.19        0.940        1.31 
## 11 Tue_…   NA       NA         NA          NA          NA           NA    
## 12 Tue_…    1.19     2.50       1.31        2.22        0.918        1.91 
## 13 Wed_…   NA       NA         NA          NA          NA           NA    
## 14 Wed_…    0.842    1.85       0.948       1.69        0.914        1.58 
## # … with 2 more variables: MASE_add_mDOW <dbl>, MASE_mul_mDOW <dbl>

#Monthly
result_month_W <- result_month %>% filter(hotel == "WARUK") %>% arrange(month) 

result_month_W_MAE <- result_month_W[names(result_month_W) %like% "MAE" | names(result_month_W) == "month"]
result_month_W_MAPE <- result_month_W[names(result_month_W) %like% "MAPE" | names(result_month_W) == "month"]
result_month_W_MASE <- result_month_W[names(result_month_W) %like% "MASE" | names(result_month_W) == "month"]

#Days prior categories
result_daysprior_W <- result_daysprior %>% filter(hotel == "WARUK") %>% arrange(days_prior_c) 

result_daysprior_W_MAE <- result_daysprior_W[names(result_daysprior_W) %like% "MAE" | names(result_daysprior_W) == "days_prior_c"]
result_daysprior_W_MAE

## # A tibble: 12 x 10
##    days_prior_c MAE_add MAE_mul MAE_add_m MAE_mul_m MAE_add_DOW MAE_mul_DOW
##    <chr>          <dbl>   <dbl>     <dbl>     <dbl>       <dbl>       <dbl>
##  1 1 to 7_in       13.1    14.4      12.7      13.7        9.44       12.8 
##  2 1 to 7_out      13.8    11.2      13.0      10.7        9.27        9.82
##  3 15 to 21_in     25.1    38.9      24.2      35.7       16.4        29.9 
##  4 15 to 21_out    27.8    29.1      25.7      28.6       19.4        21.9 
##  5 22 to 28_in     26.4    43.8      25.4      41.0       17.6        31.3 
##  6 22 to 28_out    29.2    32.0      26.6      32.3       20.9        23.6 
##  7 29 to 60_in     27.6    52.8      26.5      48.4       18.9        39.0 
##  8 29 to 60_out    31.1    34.7      27.7      32.8       23.4        29.2 
##  9 60 or more_…    28.3    53.2      26.8      48.5       19.2        48.4 
## 10 60 or more_…    30.5    41.5      27.6      38.6       24.4        36.0 
## 11 8 to 14_in      22.5    30.4      21.9      28.3       14.7        24.8 
## 12 8 to 14_out     24.6    24.8      23.1      23.4       15.8        19.0 
## # … with 3 more variables: MAE_add_mDOW <dbl>, MAE_mul_mDOW <dbl>,
## #   MAE_naive <dbl>

result_daysprior_W_MAPE <- result_daysprior_W[names(result_daysprior_W) %like% "MAPE" | names(result_daysprior_W) == "days_prior_c"]
result_daysprior_W_MAPE 

## # A tibble: 12 x 10
##    days_prior_c MAPE_add MAPE_mul MAPE_add_m MAPE_mul_m MAPE_add_DOW
##    <chr>           <dbl>    <dbl>      <dbl>      <dbl>        <dbl>
##  1 1 to 7_in       0.250    0.173      0.239      0.167        0.159
##  2 1 to 7_out      0.410    0.199      0.356      0.193        0.271
##  3 15 to 21_in     0.482    0.467      0.457      0.433        0.274
##  4 15 to 21_out    0.899    0.486      0.767      0.500        0.614
##  5 22 to 28_in     0.506    0.529      0.478      0.495        0.294
##  6 22 to 28_out    0.936    0.548      0.793      0.578        0.632
##  7 29 to 60_in     0.517    0.623      0.488      0.577        0.311
##  8 29 to 60_out    1.00     0.573      0.833      0.561        0.704
##  9 60 or more_…    0.486    0.603      0.454      0.550        0.283
## 10 60 or more_…    0.820    0.601      0.667      0.585        0.602
## 11 8 to 14_in      0.441    0.363      0.422      0.343        0.256
## 12 8 to 14_out     0.758    0.410      0.654      0.400        0.494
## # … with 4 more variables: MAPE_mul_DOW <dbl>, MAPE_add_mDOW <dbl>,
## #   MAPE_mul_mDOW <dbl>, MAPE_naive <dbl>

result_daysprior_W_MASE <- result_daysprior_W[names(result_daysprior_W) %like% "MASE" | names(result_daysprior_W) == "days_prior_c"]
result_daysprior_W_MASE

## # A tibble: 12 x 9
##    days_prior_c MASE_add MASE_mul MASE_add_m MASE_mul_m MASE_add_DOW
##    <chr>           <dbl>    <dbl>      <dbl>      <dbl>        <dbl>
##  1 1 to 7_in      NA       NA         NA         NA           NA    
##  2 1 to 7_out      0.623    0.506      0.584      0.481        0.418
##  3 15 to 21_in    NA       NA         NA         NA           NA    
##  4 15 to 21_out    1.25     1.31       1.16       1.29         0.874
##  5 22 to 28_in    NA       NA         NA         NA           NA    
##  6 22 to 28_out    1.31     1.44       1.19       1.45         0.937
##  7 29 to 60_in    NA       NA         NA         NA           NA    
##  8 29 to 60_out    1.38     1.54       1.23       1.46         1.04 
##  9 60 or more_…   NA       NA         NA         NA           NA    
## 10 60 or more_…    1.41     1.92       1.28       1.78         1.13 
## 11 8 to 14_in     NA       NA         NA         NA           NA    
## 12 8 to 14_out     1.11     1.12       1.04       1.05         0.713
## # … with 3 more variables: MASE_mul_DOW <dbl>, MASE_add_mDOW <dbl>,
## #   MASE_mul_mDOW <dbl>

6.4.1 GLWST

# manipulate data by  sample, days prior group, model, and error
result_DOW_G_MAE_g <- gather(result_DOW_G_MAE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))
result_DOW_G_MAPE_g <- gather(result_DOW_G_MAPE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))
result_DOW_G_MASE_g <- gather(result_DOW_G_MASE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))

# plot MAE errors for in and out samples by days prior across all 8 models 
g1 <- result_DOW_G_MAE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MAE by Day of Week ") +
    xlab("DOW") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 7 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by days prior across all 8 models 
g2 <- result_DOW_G_MAPE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MAPE by Day of Week ") +
    xlab("DOW") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 7 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by days prior across all 8 models 
g3 <- result_DOW_G_MASE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MASE by Day of Week  ") +
    xlab("DOW") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 56 rows containing missing values (geom_point).

# manipulate data by  sample, days prior group, model, and error
result_month_G_MAE_g <- gather(result_month_G_MAE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))
result_month_G_MAPE_g <- gather(result_month_G_MAPE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))
result_month_G_MASE_g <- gather(result_month_G_MASE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))

# plot MAE errors for in and out samples by month across all 8 models 
g1 <- result_month_G_MAE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MAE by month ") +
    xlab("month") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 12 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by month across all 8 models 
g2 <- result_month_G_MAPE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MAPE by month ") +
    xlab("monthcategory") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 12 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by month across all 8 models 
g3 <- result_month_G_MASE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MASE by month ") +
    xlab("month") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 96 rows containing missing values (geom_point).

# manipulate data by  sample, days prior group, model, and error
result_daysprior_G_MAE_g <- gather(result_daysprior_G_MAE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))
result_daysprior_G_MAPE_g <- gather(result_daysprior_G_MAPE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))
result_daysprior_G_MASE_g <- gather(result_daysprior_G_MASE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))

# plot MAE errors for in and out samples by days prior across all 8 models 
g1 <- result_daysprior_G_MAE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MAE by days priors categories ") +
    xlab("days prior category") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 6 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by days prior across all 8 models 
g2 <- result_daysprior_G_MAPE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MAPE by days priors categories ") +
    xlab("days prior category") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 6 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by days prior across all 8 models 
g3 <- result_daysprior_G_MASE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("GLWST-Compare models with MASE by days priors categories ") +
    xlab("days prior category") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 48 rows containing missing values (geom_point).

6.4.2 MLKEP

# manipulate data by  sample, days prior group, model, and error
result_DOW_M_MAE_g <- gather(result_DOW_M_MAE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))
result_DOW_M_MAPE_g <- gather(result_DOW_M_MAPE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))
result_DOW_M_MASE_g <- gather(result_DOW_M_MASE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))

# plot MAE errors for in and out samples by days prior across all 8 models 
g1 <- result_DOW_M_MAE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MAE by Day of Week ") +
    xlab("DOW") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 7 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by days prior across all 8 models 
g2 <- result_DOW_M_MAPE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MAPE by Day of Week ") +
    xlab("DOW") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 7 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by days prior across all 8 models 
g3 <- result_DOW_M_MASE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MASE by Day of Week  ") +
    xlab("DOW") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 56 rows containing missing values (geom_point).

# manipulate data by  sample, days prior group, model, and error
result_month_M_MAE_g <- gather(result_month_M_MAE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))
result_month_M_MAPE_g <- gather(result_month_M_MAPE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))
result_month_M_MASE_g <- gather(result_month_M_MASE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))

# plot MAE errors for in and out samples by month across all 8 models 
g1 <- result_month_M_MAE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MAE by month ") +
    xlab("month") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 12 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by month across all 8 models 
g2 <- result_month_M_MAPE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MAPE by month ") +
    xlab("monthcategory") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 12 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by month across all 8 models 
g3 <- result_month_M_MASE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MASE by month ") +
    xlab("month") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 96 rows containing missing values (geom_point).

# manipulate data by  sample, days prior group, model, and error
result_daysprior_M_MAE_g <- gather(result_daysprior_M_MAE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))
result_daysprior_M_MAPE_g <- gather(result_daysprior_M_MAPE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))
result_daysprior_M_MASE_g <- gather(result_daysprior_M_MASE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))

# plot MAE errors for in and out samples by days prior across all 8 models 
g1 <- result_daysprior_M_MAE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MAE by days priors categories ") +
    xlab("days prior category") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 6 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by days prior across all 8 models 
g2 <- result_daysprior_M_MAPE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MAPE by days priors categories ") +
    xlab("days prior category") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 6 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by days prior across all 8 models 
g3 <- result_daysprior_M_MASE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("MLKEP-Compare models with MASE by days priors categories ") +
    xlab("days prior category") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 48 rows containing missing values (geom_point).

6.4.3 WARUK

# manipulate data by  sample, days prior group, model, and error
result_DOW_W_MAE_g <- gather(result_DOW_W_MAE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))
result_DOW_W_MAPE_g <- gather(result_DOW_W_MAPE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))
result_DOW_W_MASE_g <- gather(result_DOW_W_MASE, models, error, c(-DOW)) %>%  
           mutate( sample = ifelse(grepl('in', DOW),'in', 'out'
                              ))

# plot MAE errors for in and out samples by days prior across all 8 models 
g1 <- result_DOW_W_MAE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MAE by Day of Week ") +
    xlab("DOW") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 7 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by days prior across all 8 models 
g2 <- result_DOW_W_MAPE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MAPE by Day of Week ") +
    xlab("DOW") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 7 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by days prior across all 8 models 
g3 <- result_DOW_W_MASE_g %>% 
    ggplot(aes(x = DOW,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MASE by Day of Week  ") +
    xlab("DOW") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 56 rows containing missing values (geom_point).

# manipulate data by  sample, days prior group, model, and error
result_month_W_MAE_g <- gather(result_month_W_MAE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))
result_month_W_MAPE_g <- gather(result_month_W_MAPE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))
result_month_W_MASE_g <- gather(result_month_W_MASE, models, error, c(-month)) %>%  
           mutate( sample = ifelse(grepl('in', month),'in', 'out'
                              ))

# plot MAE errors for in and out samples by month across all 8 models 
g1 <- result_month_W_MAE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MAE by month ") +
    xlab("month") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 12 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by month across all 8 models 
g2 <- result_month_W_MAPE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MAPE by month ") +
    xlab("monthcategory") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 12 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by month across all 8 models 
g3 <- result_month_W_MASE_g %>% 
    ggplot(aes(x = month,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MASE by month ") +
    xlab("month") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 96 rows containing missing values (geom_point).

# manipulate data by  sample, days prior group, model, and error
result_daysprior_W_MAE_g <- gather(result_daysprior_W_MAE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))
result_daysprior_W_MAPE_g <- gather(result_daysprior_W_MAPE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))
result_daysprior_W_MASE_g <- gather(result_daysprior_W_MASE, models, error, c(-days_prior_c)) %>%  
           mutate( sample = ifelse(grepl('in', days_prior_c),'in', 'out'
                              ))

# plot MAE errors for in and out samples by days prior across all 8 models 
g1 <- result_daysprior_W_MAE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MAE by days priors categories ") +
    xlab("days prior category") + ylab("MAE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g1

## Warning: Removed 6 rows containing missing values (geom_point).

# plot MAPE errors for in and out samples by days prior across all 8 models 
g2 <- result_daysprior_W_MAPE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MAPE by days priors categories ") +
    xlab("days prior category") + ylab("MAPE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g2

## Warning: Removed 6 rows containing missing values (geom_point).

# plot MASE errors for in and out samples by days prior across all 8 models 
g3 <- result_daysprior_W_MASE_g %>% 
    ggplot(aes(x = days_prior_c,y = error)) + 
    geom_point(aes(color= models),size=1.5) +
    ggtitle("WARUK-Compare models with MASE by days priors categories ") +
    xlab("days prior category") + ylab("MASE errors")+
    coord_flip() + 
    scale_y_log10() +
    facet_wrap(~ sample)
g3

## Warning: Removed 48 rows containing missing values (geom_point).

7.2.1 create naive model

fc_snaive <- function(time1,time2,hotel_no,time3,time4) { 
# snaive model
k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(naive_dataset_ts,end=k)
fc_ts <- snaive(training_ts[,hotel_no], h = k1) 
return(fc_ts) 
}

7.2.2 create ses model

fc_ses <- function(time1,time2,hotel_no,time3,time4) { 
  # ses model
  k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
  k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
  training_ts <- subset(smoothing_dataset_ts,end=k)
  fc_ts <- ses(training_ts[,hotel_no], h = k1) 
  
  return(fc_ts) 
}

7.2.3 create holt model

fc_holt <- function(time1,time2,hotel_no,time3,time4) { 
  # holt model
  k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
  k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
  training_ts <- subset(smoothing_dataset_ts,end=k)
  fc_ts <- holt(training_ts[,hotel_no], h = k1) 
  
  return(fc_ts)
}

7.2.4 create Holt-Winters model

fc_hw <- function(time1,time2,hotel_no,time3,time4,season) { 
  # holt-winters model
  k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
  k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
  training_ts <- subset(smoothing_dataset_ts,end=k)
  fc_ts<- hw(training_ts[,hotel_no],h=k1,seasonal=season,damped = TRUE)
  
  return(fc_ts) 
}

7.2.5 create forecast result function

fc_result <- function(hotel_no) {
  
# snaive forecast result
## six-month forecasting errors
six_month_snaive <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") %>% accuracy(naive_dataset_ts[,hotel_no])

## three-month forecasting errors
three_month_1_snaive <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") %>% accuracy(naive_dataset_ts[,hotel_no])
three_month_2_snaive <-fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") %>% accuracy(naive_dataset_ts[,hotel_no])
three_month_3_snaive <-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") %>% accuracy(naive_dataset_ts[,hotel_no])
three_month_4_snaive <-fc_snaive("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") %>% accuracy(naive_dataset_ts[,hotel_no])

## one-month forecasting errors
one_month_1_snaive <- fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_2_snaive <- fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_3_snaive <- fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_4_snaive <- fc_snaive("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_5_snaive <- fc_snaive("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") %>% accuracy(naive_dataset_ts[,hotel_no])
one_month_6_snaive <- fc_snaive("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") %>% accuracy(naive_dataset_ts[,hotel_no])



# ses forecast result
## six-month forecasting errors
six_month_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])

## three-month forecasting errors
three_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_ses <-fc_ses("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])

## one-month forecasting errors
one_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_ses <-fc_ses("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_ses <-fc_ses("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_ses <-fc_ses("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])



# holt forecast result
## six-month forecasting errors
six_month_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])

## three-month forecasting errors
three_month_1_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_holt <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_holt <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_holt <-fc_holt("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])

## one-month forecasting errors
one_month_1_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_holt <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_holt <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_holt <-fc_holt("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_holt <-fc_holt("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_holt <-fc_holt("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") %>% accuracy(smoothing_dataset_ts[,hotel_no])



# hw - additive
# six-month forecasting errors
six_month_hw_a <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])

# three-month forecasting errors
three_month_1_hw_a <- fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_hw_a <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_hw_a <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_hw_a <- fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])

# one-month forecasting errors
one_month_1_hw_a <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_hw_a<-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_hw_a <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_hw_a <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_hw_a <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_hw_a <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30", "additive") %>% accuracy(smoothing_dataset_ts[,hotel_no])


# hw - multiplicative
# six-month forecasting errors
six_month_hw_m <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])

# three-month forecasting errors
three_month_1_hw_m  <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_2_hw_m  <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_3_hw_m  <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2009-01-01","2010-03-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
three_month_4_hw_m  <-fc_hw("2008-05-01","2010-01-30",hotel_no,"2010-02-01","2010-04-30", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])

# one-month forecasting errors
one_month_1_hw_m  <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_2_hw_m  <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_3_hw_m  <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_4_hw_m  <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_5_hw_m  <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])
one_month_6_hw_m  <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30", "multiplicative") %>% accuracy(smoothing_dataset_ts[,hotel_no])



# combine all the result as matrix
naive_result <- rbind(six_month_snaive,three_month_1_snaive,three_month_2_snaive,three_month_3_snaive,three_month_4_snaive,one_month_1_snaive,one_month_2_snaive,one_month_3_snaive,one_month_4_snaive,one_month_5_snaive,one_month_6_snaive)
ses_result<-rbind(six_month_ses,three_month_1_ses,three_month_2_ses,three_month_3_ses,three_month_4_ses,one_month_1_ses,one_month_2_ses,one_month_3_ses,one_month_4_ses,one_month_5_ses,one_month_6_ses)
holt_result<-rbind(six_month_holt,three_month_1_holt,three_month_2_holt,three_month_3_holt,three_month_4_holt,one_month_1_holt,one_month_2_holt,one_month_3_holt,one_month_4_holt,one_month_5_holt,one_month_6_holt)
hw_add_result<-rbind(six_month_hw_a ,three_month_1_hw_a ,three_month_2_hw_a ,three_month_3_hw_a,three_month_4_hw_a,one_month_1_hw_a ,one_month_2_hw_a ,one_month_3_hw_a ,one_month_4_hw_a ,one_month_5_hw_a ,one_month_6_hw_a )
hw_mul_result<-rbind(six_month_hw_m,three_month_1_hw_m,three_month_2_hw_m,three_month_3_hw_m,three_month_4_hw_m,one_month_1_hw_m,one_month_2_hw_m,one_month_3_hw_m,one_month_4_hw_m,one_month_5_hw_m,one_month_6_hw_m)



# transfer to data frame and only keep test data result and MAE and MAPE
naive_result.df <- as.data.frame(naive_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0|row_number()%%2==1)
ses_result.df<- as.data.frame(ses_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)
holt_result.df<- as.data.frame(holt_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)
hw_add_result.df<- as.data.frame(hw_add_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)
hw_mul_result.df<- as.data.frame(hw_mul_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2==1)



# rename the row name

naive_result<-data.frame( forecast_period = fc_timestamp, naive_result.df)
ses_result<-data.frame( forecast_period  =  fc_timestamp, ses_result.df)
holt_result<-data.frame( forecast_period  =  fc_timestamp, holt_result.df)
hw_add_result<-data.frame( forecast_period =  fc_timestamp, hw_add_result.df)
hw_mul_result<-data.frame( forecast_period =  fc_timestamp, hw_mul_result.df)


# calculate MASE
ses_result <- ses_result %>% mutate(MASE=as.matrix(ses_result["MAE"])/as.matrix(naive_result["MAE"]))
holt_result <- holt_result %>% mutate(MASE=as.matrix(holt_result["MAE"])/as.matrix(naive_result["MAE"]))
hw_add_result <- hw_add_result %>% mutate(MASE=as.matrix(hw_add_result["MAE"])/as.matrix(naive_result["MAE"]))
hw_mul_result <- hw_mul_result %>% mutate(MASE=as.matrix(hw_mul_result["MAE"])/as.matrix(naive_result["MAE"]))

# mutate MAPE as decimal number
ses_result <- ses_result %>% mutate(MAPE = MAPE/100)
holt_result <- holt_result %>% mutate(MAPE =  MAPE/100)
hw_add_result <- hw_add_result %>% mutate(MAPE =  MAPE/100)
hw_mul_result <- hw_mul_result %>% mutate(MAPE =  MAPE/100)

# remove MASE for in-sample
ses_result <- ses_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
holt_result <- holt_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
hw_add_result <- hw_add_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))
hw_mul_result <- hw_mul_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))

return(list(naive = naive_result,ses = ses_result,holt = holt_result,hw_add = hw_add_result,hw_mul = hw_mul_result))
}

fc_result(1)

## $naive
##    forecast_period      MAE     MAPE
## 1    6m_Nov-Apr_in 16.60000 18.05998
## 2   6m_Nov-Apr_out 19.58011 26.40135
## 3    3m_Nov-Jan_in 16.60000 18.05998
## 4   3m_Nov-Jan_out 18.17391 27.13037
## 5    3m_Dec-Feb_in 16.70233 18.12707
## 6   3m_Dec-Feb_out 16.92222 27.08021
## 7    3m_Jan-Mar_in 17.29675 20.45249
## 8   3m_Jan-Mar_out 18.82222 25.96150
## 9    3m_Feb-Apr_in 17.12274 21.07253
## 10  3m_Feb-Apr_out 21.03371 25.64776
## 11       1m_Nov_in 16.60000 18.05998
## 12      1m_Nov_out 17.33333 18.54077
## 13       1m_Dec_in 16.70233 18.12707
## 14      1m_Dec_out 21.41935 36.58038
## 15       1m_Jan_in 17.29675 20.45249
## 16      1m_Jan_out 15.74194 25.99288
## 17       1m_Feb_in      NaN      NaN
## 18      1m_Feb_out 24.28571 31.09985
## 19       1m_Mar_in 16.76721 20.76898
## 20      1m_Mar_out 26.93548 33.33250
## 21       1m_Apr_in 17.70536 21.92811
## 22      1m_Apr_out 22.20000 25.06319
## 
## $ses
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 17.16472 0.2108561               NaN
## 2   6m_Nov-Apr_out 29.56734 0.5061138  1.51007031723736
## 3    3m_Nov-Jan_in 17.16472 0.2108561               NaN
## 4   3m_Nov-Jan_out 34.69838 0.6701037  1.90924101308585
## 5    3m_Dec-Feb_in 17.14492 0.2095655               NaN
## 6   3m_Dec-Feb_out 31.32584 0.5987116  1.85116595265857
## 7    3m_Jan-Mar_in 17.62643 0.2221101               NaN
## 8   3m_Jan-Mar_out 23.17962 0.3181623  1.23150299808857
## 9    3m_Feb-Apr_in 17.48667 0.2230310               NaN
## 10  3m_Feb-Apr_out 23.26497 0.2405159  1.10608052462494
## 11       1m_Nov_in 17.16472 0.2108561               NaN
## 12      1m_Nov_out 17.12180 0.1985084 0.987796146118206
## 13       1m_Dec_in 17.14492 0.2095655               NaN
## 14      1m_Dec_out 31.91392 0.6757493   1.4899569826427
## 15       1m_Jan_in 17.62643 0.2221101               NaN
## 16      1m_Jan_out 23.07441 0.4614499  1.46579268309207
## 17       1m_Feb_in 17.98274 0.2336794               NaN
## 18      1m_Feb_out 22.95372 0.3156966 0.945153313792086
## 19       1m_Mar_in 17.55837 0.2231886               NaN
## 20      1m_Mar_out 23.50660 0.2679289 0.872700225739768
## 21       1m_Apr_in 17.73291 0.2250199               NaN
## 22      1m_Apr_out 20.98610 0.2778388 0.945319629121382
## 
## $holt
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 17.13131 0.2106789               NaN
## 2   6m_Nov-Apr_out 30.70201 0.5241845  1.56802032878809
## 3    3m_Nov-Jan_in 17.13131 0.2106789               NaN
## 4   3m_Nov-Jan_out 35.46322 0.6845672  1.95132532723337
## 5    3m_Dec-Feb_in 17.12651 0.2093029               NaN
## 6   3m_Dec-Feb_out 31.26093 0.5973831   1.8473298401296
## 7    3m_Jan-Mar_in 17.63378 0.2216822               NaN
## 8   3m_Jan-Mar_out 23.73684 0.3190124  1.26110703952513
## 9    3m_Feb-Apr_in 17.49045 0.2225737               NaN
## 10  3m_Feb-Apr_out 24.07563 0.2452765  1.14462111892475
## 11       1m_Nov_in 17.13131 0.2106789               NaN
## 12      1m_Nov_out 17.26091 0.2005270 0.995821556838069
## 13       1m_Dec_in 17.12651 0.2093029               NaN
## 14      1m_Dec_out 31.88626 0.6750160  1.48866583852698
## 15       1m_Jan_in 17.63378 0.2216822               NaN
## 16      1m_Jan_out 22.93960 0.4567448  1.45722866851363
## 17       1m_Feb_in 17.49045 0.2225737               NaN
## 18      1m_Feb_out 20.46945 0.2174224 0.842859605534413
## 19       1m_Mar_in 17.55315 0.2227842               NaN
## 20      1m_Mar_out 23.66548 0.2683444 0.878598827909082
## 21       1m_Apr_in 17.71103 0.2248767               NaN
## 22      1m_Apr_out 21.30267 0.2819059 0.959579656671636
## 
## $hw_add
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 14.23579 0.1677099               NaN
## 2   6m_Nov-Apr_out 24.39895 0.4202772  1.24610869159936
## 3    3m_Nov-Jan_in 14.23579 0.1677099               NaN
## 4   3m_Nov-Jan_out 28.91156 0.5722553  1.59082739119975
## 5    3m_Dec-Feb_in 14.03028 0.1644125               NaN
## 6   3m_Dec-Feb_out 31.17146 0.6116655  1.84204320025238
## 7    3m_Jan-Mar_in 14.47323 0.1735547               NaN
## 8   3m_Jan-Mar_out 24.72472 0.4175608  1.31359172056293
## 9    3m_Feb-Apr_in 14.55219 0.1787784               NaN
## 10  3m_Feb-Apr_out 20.84123 0.2081257 0.990849252153732
## 11       1m_Nov_in 14.23579 0.1677099               NaN
## 12      1m_Nov_out 11.89435 0.1286130 0.686212323034542
## 13       1m_Dec_in 14.03028 0.1644125               NaN
## 14      1m_Dec_out 30.40857 0.6878321  1.41967708388251
## 15       1m_Jan_in 14.47323 0.1735547               NaN
## 16      1m_Jan_out 36.65615 0.7486518  2.32856705580899
## 17       1m_Feb_in 14.55219 0.1787784               NaN
## 18      1m_Feb_out 17.53358 0.1833935 0.721970880917249
## 19       1m_Mar_in 14.58160 0.1785943               NaN
## 20      1m_Mar_out 18.45737 0.2129133 0.685243730902185
## 21       1m_Apr_in 14.59907 0.1787301               NaN
## 22      1m_Apr_out 24.28184 0.3053951  1.09377652193263
## 
## $hw_mul
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 14.68280 0.1725621               NaN
## 2   6m_Nov-Apr_out 24.82579 0.4277763   1.2679087638248
## 3    3m_Nov-Jan_in 14.68280 0.1725621               NaN
## 4   3m_Nov-Jan_out 29.40811 0.5808797  1.61814948410176
## 5    3m_Dec-Feb_in 14.54415 0.1705139               NaN
## 6   3m_Dec-Feb_out 30.20617 0.5924527  1.78500014535895
## 7    3m_Jan-Mar_in 14.83175 0.1770651               NaN
## 8   3m_Jan-Mar_out 21.86841 0.3419958  1.16183997927205
## 9    3m_Feb-Apr_in 14.79067 0.1791103               NaN
## 10  3m_Feb-Apr_out 18.11542 0.2121346  0.86125672682618
## 11       1m_Nov_in 14.68280 0.1725621               NaN
## 12      1m_Nov_out 12.17564 0.1328571 0.702440627424316
## 13       1m_Dec_in 14.54415 0.1705139               NaN
## 14      1m_Dec_out 30.03456 0.6715978  1.40221584981471
## 15       1m_Jan_in 14.83175 0.1770651               NaN
## 16      1m_Jan_out 33.55495 0.6932201  2.13156450930606
## 17       1m_Feb_in 14.80548 0.1797262               NaN
## 18      1m_Feb_out 19.02115 0.1945147 0.783223727928355
## 19       1m_Mar_in 14.82875 0.1794635               NaN
## 20      1m_Mar_out 20.02641 0.2262414 0.743495441486405
## 21       1m_Apr_in 14.93417 0.1813381               NaN
## 22      1m_Apr_out 24.55066 0.3060608  1.10588551357609

fc_result_across <- function(hotel_no) {k<-fc_result(hotel_no) 
  MAE <-data.frame(forecast_period= k[["naive"]][,1],ses=k[["ses"]][,2],holt=k[["holt"]][,2],hw_add=k[["hw_add"]][,2],hw_mul=k[["hw_mul"]][,2])
  
  MAPE <-data.frame(forecast_period  =k[["naive"]][,1],ses=k[["ses"]][,3],holt=k[["holt"]][,3],hw_add=k[["hw_add"]][,3],hw_mul=k[["hw_mul"]][,3])
  
  MASE <- data.frame( forecast_period =k[["naive"]][,1],ses=k[["ses"]][,4],holt=k[["holt"]][,4],hw_add=k[["hw_add"]][,4],hw_mul=k[["hw_mul"]][,4])
  
  return(list(MAE=MAE, MAPE=MAPE,MASE=MASE))
}

7.3.1 GLWST

fc_result(1)

## $naive
##    forecast_period      MAE     MAPE
## 1    6m_Nov-Apr_in 16.60000 18.05998
## 2   6m_Nov-Apr_out 19.58011 26.40135
## 3    3m_Nov-Jan_in 16.60000 18.05998
## 4   3m_Nov-Jan_out 18.17391 27.13037
## 5    3m_Dec-Feb_in 16.70233 18.12707
## 6   3m_Dec-Feb_out 16.92222 27.08021
## 7    3m_Jan-Mar_in 17.29675 20.45249
## 8   3m_Jan-Mar_out 18.82222 25.96150
## 9    3m_Feb-Apr_in 17.12274 21.07253
## 10  3m_Feb-Apr_out 21.03371 25.64776
## 11       1m_Nov_in 16.60000 18.05998
## 12      1m_Nov_out 17.33333 18.54077
## 13       1m_Dec_in 16.70233 18.12707
## 14      1m_Dec_out 21.41935 36.58038
## 15       1m_Jan_in 17.29675 20.45249
## 16      1m_Jan_out 15.74194 25.99288
## 17       1m_Feb_in      NaN      NaN
## 18      1m_Feb_out 24.28571 31.09985
## 19       1m_Mar_in 16.76721 20.76898
## 20      1m_Mar_out 26.93548 33.33250
## 21       1m_Apr_in 17.70536 21.92811
## 22      1m_Apr_out 22.20000 25.06319
## 
## $ses
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 17.16472 0.2108561               NaN
## 2   6m_Nov-Apr_out 29.56734 0.5061138  1.51007031723736
## 3    3m_Nov-Jan_in 17.16472 0.2108561               NaN
## 4   3m_Nov-Jan_out 34.69838 0.6701037  1.90924101308585
## 5    3m_Dec-Feb_in 17.14492 0.2095655               NaN
## 6   3m_Dec-Feb_out 31.32584 0.5987116  1.85116595265857
## 7    3m_Jan-Mar_in 17.62643 0.2221101               NaN
## 8   3m_Jan-Mar_out 23.17962 0.3181623  1.23150299808857
## 9    3m_Feb-Apr_in 17.48667 0.2230310               NaN
## 10  3m_Feb-Apr_out 23.26497 0.2405159  1.10608052462494
## 11       1m_Nov_in 17.16472 0.2108561               NaN
## 12      1m_Nov_out 17.12180 0.1985084 0.987796146118206
## 13       1m_Dec_in 17.14492 0.2095655               NaN
## 14      1m_Dec_out 31.91392 0.6757493   1.4899569826427
## 15       1m_Jan_in 17.62643 0.2221101               NaN
## 16      1m_Jan_out 23.07441 0.4614499  1.46579268309207
## 17       1m_Feb_in 17.98274 0.2336794               NaN
## 18      1m_Feb_out 22.95372 0.3156966 0.945153313792086
## 19       1m_Mar_in 17.55837 0.2231886               NaN
## 20      1m_Mar_out 23.50660 0.2679289 0.872700225739768
## 21       1m_Apr_in 17.73291 0.2250199               NaN
## 22      1m_Apr_out 20.98610 0.2778388 0.945319629121382
## 
## $holt
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 17.13131 0.2106789               NaN
## 2   6m_Nov-Apr_out 30.70201 0.5241845  1.56802032878809
## 3    3m_Nov-Jan_in 17.13131 0.2106789               NaN
## 4   3m_Nov-Jan_out 35.46322 0.6845672  1.95132532723337
## 5    3m_Dec-Feb_in 17.12651 0.2093029               NaN
## 6   3m_Dec-Feb_out 31.26093 0.5973831   1.8473298401296
## 7    3m_Jan-Mar_in 17.63378 0.2216822               NaN
## 8   3m_Jan-Mar_out 23.73684 0.3190124  1.26110703952513
## 9    3m_Feb-Apr_in 17.49045 0.2225737               NaN
## 10  3m_Feb-Apr_out 24.07563 0.2452765  1.14462111892475
## 11       1m_Nov_in 17.13131 0.2106789               NaN
## 12      1m_Nov_out 17.26091 0.2005270 0.995821556838069
## 13       1m_Dec_in 17.12651 0.2093029               NaN
## 14      1m_Dec_out 31.88626 0.6750160  1.48866583852698
## 15       1m_Jan_in 17.63378 0.2216822               NaN
## 16      1m_Jan_out 22.93960 0.4567448  1.45722866851363
## 17       1m_Feb_in 17.49045 0.2225737               NaN
## 18      1m_Feb_out 20.46945 0.2174224 0.842859605534413
## 19       1m_Mar_in 17.55315 0.2227842               NaN
## 20      1m_Mar_out 23.66548 0.2683444 0.878598827909082
## 21       1m_Apr_in 17.71103 0.2248767               NaN
## 22      1m_Apr_out 21.30267 0.2819059 0.959579656671636
## 
## $hw_add
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 14.23579 0.1677099               NaN
## 2   6m_Nov-Apr_out 24.39895 0.4202772  1.24610869159936
## 3    3m_Nov-Jan_in 14.23579 0.1677099               NaN
## 4   3m_Nov-Jan_out 28.91156 0.5722553  1.59082739119975
## 5    3m_Dec-Feb_in 14.03028 0.1644125               NaN
## 6   3m_Dec-Feb_out 31.17146 0.6116655  1.84204320025238
## 7    3m_Jan-Mar_in 14.47323 0.1735547               NaN
## 8   3m_Jan-Mar_out 24.72472 0.4175608  1.31359172056293
## 9    3m_Feb-Apr_in 14.55219 0.1787784               NaN
## 10  3m_Feb-Apr_out 20.84123 0.2081257 0.990849252153732
## 11       1m_Nov_in 14.23579 0.1677099               NaN
## 12      1m_Nov_out 11.89435 0.1286130 0.686212323034542
## 13       1m_Dec_in 14.03028 0.1644125               NaN
## 14      1m_Dec_out 30.40857 0.6878321  1.41967708388251
## 15       1m_Jan_in 14.47323 0.1735547               NaN
## 16      1m_Jan_out 36.65615 0.7486518  2.32856705580899
## 17       1m_Feb_in 14.55219 0.1787784               NaN
## 18      1m_Feb_out 17.53358 0.1833935 0.721970880917249
## 19       1m_Mar_in 14.58160 0.1785943               NaN
## 20      1m_Mar_out 18.45737 0.2129133 0.685243730902185
## 21       1m_Apr_in 14.59907 0.1787301               NaN
## 22      1m_Apr_out 24.28184 0.3053951  1.09377652193263
## 
## $hw_mul
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 14.68280 0.1725621               NaN
## 2   6m_Nov-Apr_out 24.82579 0.4277763   1.2679087638248
## 3    3m_Nov-Jan_in 14.68280 0.1725621               NaN
## 4   3m_Nov-Jan_out 29.40811 0.5808797  1.61814948410176
## 5    3m_Dec-Feb_in 14.54415 0.1705139               NaN
## 6   3m_Dec-Feb_out 30.20617 0.5924527  1.78500014535895
## 7    3m_Jan-Mar_in 14.83175 0.1770651               NaN
## 8   3m_Jan-Mar_out 21.86841 0.3419958  1.16183997927205
## 9    3m_Feb-Apr_in 14.79067 0.1791103               NaN
## 10  3m_Feb-Apr_out 18.11542 0.2121346  0.86125672682618
## 11       1m_Nov_in 14.68280 0.1725621               NaN
## 12      1m_Nov_out 12.17564 0.1328571 0.702440627424316
## 13       1m_Dec_in 14.54415 0.1705139               NaN
## 14      1m_Dec_out 30.03456 0.6715978  1.40221584981471
## 15       1m_Jan_in 14.83175 0.1770651               NaN
## 16      1m_Jan_out 33.55495 0.6932201  2.13156450930606
## 17       1m_Feb_in 14.80548 0.1797262               NaN
## 18      1m_Feb_out 19.02115 0.1945147 0.783223727928355
## 19       1m_Mar_in 14.82875 0.1794635               NaN
## 20      1m_Mar_out 20.02641 0.2262414 0.743495441486405
## 21       1m_Apr_in 14.93417 0.1813381               NaN
## 22      1m_Apr_out 24.55066 0.3060608  1.10588551357609

fc_result_across(1)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul
## 1    6m_Nov-Apr_in 17.16472 17.13131 14.23579 14.68280
## 2   6m_Nov-Apr_out 29.56734 30.70201 24.39895 24.82579
## 3    3m_Nov-Jan_in 17.16472 17.13131 14.23579 14.68280
## 4   3m_Nov-Jan_out 34.69838 35.46322 28.91156 29.40811
## 5    3m_Dec-Feb_in 17.14492 17.12651 14.03028 14.54415
## 6   3m_Dec-Feb_out 31.32584 31.26093 31.17146 30.20617
## 7    3m_Jan-Mar_in 17.62643 17.63378 14.47323 14.83175
## 8   3m_Jan-Mar_out 23.17962 23.73684 24.72472 21.86841
## 9    3m_Feb-Apr_in 17.48667 17.49045 14.55219 14.79067
## 10  3m_Feb-Apr_out 23.26497 24.07563 20.84123 18.11542
## 11       1m_Nov_in 17.16472 17.13131 14.23579 14.68280
## 12      1m_Nov_out 17.12180 17.26091 11.89435 12.17564
## 13       1m_Dec_in 17.14492 17.12651 14.03028 14.54415
## 14      1m_Dec_out 31.91392 31.88626 30.40857 30.03456
## 15       1m_Jan_in 17.62643 17.63378 14.47323 14.83175
## 16      1m_Jan_out 23.07441 22.93960 36.65615 33.55495
## 17       1m_Feb_in 17.98274 17.49045 14.55219 14.80548
## 18      1m_Feb_out 22.95372 20.46945 17.53358 19.02115
## 19       1m_Mar_in 17.55837 17.55315 14.58160 14.82875
## 20      1m_Mar_out 23.50660 23.66548 18.45737 20.02641
## 21       1m_Apr_in 17.73291 17.71103 14.59907 14.93417
## 22      1m_Apr_out 20.98610 21.30267 24.28184 24.55066
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul
## 1    6m_Nov-Apr_in 0.2108561 0.2106789 0.1677099 0.1725621
## 2   6m_Nov-Apr_out 0.5061138 0.5241845 0.4202772 0.4277763
## 3    3m_Nov-Jan_in 0.2108561 0.2106789 0.1677099 0.1725621
## 4   3m_Nov-Jan_out 0.6701037 0.6845672 0.5722553 0.5808797
## 5    3m_Dec-Feb_in 0.2095655 0.2093029 0.1644125 0.1705139
## 6   3m_Dec-Feb_out 0.5987116 0.5973831 0.6116655 0.5924527
## 7    3m_Jan-Mar_in 0.2221101 0.2216822 0.1735547 0.1770651
## 8   3m_Jan-Mar_out 0.3181623 0.3190124 0.4175608 0.3419958
## 9    3m_Feb-Apr_in 0.2230310 0.2225737 0.1787784 0.1791103
## 10  3m_Feb-Apr_out 0.2405159 0.2452765 0.2081257 0.2121346
## 11       1m_Nov_in 0.2108561 0.2106789 0.1677099 0.1725621
## 12      1m_Nov_out 0.1985084 0.2005270 0.1286130 0.1328571
## 13       1m_Dec_in 0.2095655 0.2093029 0.1644125 0.1705139
## 14      1m_Dec_out 0.6757493 0.6750160 0.6878321 0.6715978
## 15       1m_Jan_in 0.2221101 0.2216822 0.1735547 0.1770651
## 16      1m_Jan_out 0.4614499 0.4567448 0.7486518 0.6932201
## 17       1m_Feb_in 0.2336794 0.2225737 0.1787784 0.1797262
## 18      1m_Feb_out 0.3156966 0.2174224 0.1833935 0.1945147
## 19       1m_Mar_in 0.2231886 0.2227842 0.1785943 0.1794635
## 20      1m_Mar_out 0.2679289 0.2683444 0.2129133 0.2262414
## 21       1m_Apr_in 0.2250199 0.2248767 0.1787301 0.1813381
## 22      1m_Apr_out 0.2778388 0.2819059 0.3053951 0.3060608
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out  1.51007031723736  1.56802032878809  1.24610869159936
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  1.90924101308585  1.95132532723337  1.59082739119975
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  1.85116595265857   1.8473298401296  1.84204320025238
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  1.23150299808857  1.26110703952513  1.31359172056293
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out  1.10608052462494  1.14462111892475 0.990849252153732
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out 0.987796146118206 0.995821556838069 0.686212323034542
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out   1.4899569826427  1.48866583852698  1.41967708388251
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  1.46579268309207  1.45722866851363  2.32856705580899
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.945153313792086 0.842859605534413 0.721970880917249
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out 0.872700225739768 0.878598827909082 0.685243730902185
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out 0.945319629121382 0.959579656671636  1.09377652193263
##               hw_mul
## 1                NaN
## 2    1.2679087638248
## 3                NaN
## 4   1.61814948410176
## 5                NaN
## 6   1.78500014535895
## 7                NaN
## 8   1.16183997927205
## 9                NaN
## 10  0.86125672682618
## 11               NaN
## 12 0.702440627424316
## 13               NaN
## 14  1.40221584981471
## 15               NaN
## 16  2.13156450930606
## 17               NaN
## 18 0.783223727928355
## 19               NaN
## 20 0.743495441486405
## 21               NaN
## 22  1.10588551357609

fc_timestamp_out<-c("6m_Nov-Apr_out","3m_Nov-Jan_out","3m_Dec-Feb_out","3m_Jan-Mar_out","3m_Feb-Apr_out","1m_Nov_out","1m_Dec_out","1m_Jan_out","1m_Feb_out","1m_Mar_out","1m_Apr_out") 

fc_result_across(1)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul
## 1    6m_Nov-Apr_in 17.16472 17.13131 14.23579 14.68280
## 2   6m_Nov-Apr_out 29.56734 30.70201 24.39895 24.82579
## 3    3m_Nov-Jan_in 17.16472 17.13131 14.23579 14.68280
## 4   3m_Nov-Jan_out 34.69838 35.46322 28.91156 29.40811
## 5    3m_Dec-Feb_in 17.14492 17.12651 14.03028 14.54415
## 6   3m_Dec-Feb_out 31.32584 31.26093 31.17146 30.20617
## 7    3m_Jan-Mar_in 17.62643 17.63378 14.47323 14.83175
## 8   3m_Jan-Mar_out 23.17962 23.73684 24.72472 21.86841
## 9    3m_Feb-Apr_in 17.48667 17.49045 14.55219 14.79067
## 10  3m_Feb-Apr_out 23.26497 24.07563 20.84123 18.11542
## 11       1m_Nov_in 17.16472 17.13131 14.23579 14.68280
## 12      1m_Nov_out 17.12180 17.26091 11.89435 12.17564
## 13       1m_Dec_in 17.14492 17.12651 14.03028 14.54415
## 14      1m_Dec_out 31.91392 31.88626 30.40857 30.03456
## 15       1m_Jan_in 17.62643 17.63378 14.47323 14.83175
## 16      1m_Jan_out 23.07441 22.93960 36.65615 33.55495
## 17       1m_Feb_in 17.98274 17.49045 14.55219 14.80548
## 18      1m_Feb_out 22.95372 20.46945 17.53358 19.02115
## 19       1m_Mar_in 17.55837 17.55315 14.58160 14.82875
## 20      1m_Mar_out 23.50660 23.66548 18.45737 20.02641
## 21       1m_Apr_in 17.73291 17.71103 14.59907 14.93417
## 22      1m_Apr_out 20.98610 21.30267 24.28184 24.55066
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul
## 1    6m_Nov-Apr_in 0.2108561 0.2106789 0.1677099 0.1725621
## 2   6m_Nov-Apr_out 0.5061138 0.5241845 0.4202772 0.4277763
## 3    3m_Nov-Jan_in 0.2108561 0.2106789 0.1677099 0.1725621
## 4   3m_Nov-Jan_out 0.6701037 0.6845672 0.5722553 0.5808797
## 5    3m_Dec-Feb_in 0.2095655 0.2093029 0.1644125 0.1705139
## 6   3m_Dec-Feb_out 0.5987116 0.5973831 0.6116655 0.5924527
## 7    3m_Jan-Mar_in 0.2221101 0.2216822 0.1735547 0.1770651
## 8   3m_Jan-Mar_out 0.3181623 0.3190124 0.4175608 0.3419958
## 9    3m_Feb-Apr_in 0.2230310 0.2225737 0.1787784 0.1791103
## 10  3m_Feb-Apr_out 0.2405159 0.2452765 0.2081257 0.2121346
## 11       1m_Nov_in 0.2108561 0.2106789 0.1677099 0.1725621
## 12      1m_Nov_out 0.1985084 0.2005270 0.1286130 0.1328571
## 13       1m_Dec_in 0.2095655 0.2093029 0.1644125 0.1705139
## 14      1m_Dec_out 0.6757493 0.6750160 0.6878321 0.6715978
## 15       1m_Jan_in 0.2221101 0.2216822 0.1735547 0.1770651
## 16      1m_Jan_out 0.4614499 0.4567448 0.7486518 0.6932201
## 17       1m_Feb_in 0.2336794 0.2225737 0.1787784 0.1797262
## 18      1m_Feb_out 0.3156966 0.2174224 0.1833935 0.1945147
## 19       1m_Mar_in 0.2231886 0.2227842 0.1785943 0.1794635
## 20      1m_Mar_out 0.2679289 0.2683444 0.2129133 0.2262414
## 21       1m_Apr_in 0.2250199 0.2248767 0.1787301 0.1813381
## 22      1m_Apr_out 0.2778388 0.2819059 0.3053951 0.3060608
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out  1.51007031723736  1.56802032878809  1.24610869159936
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  1.90924101308585  1.95132532723337  1.59082739119975
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  1.85116595265857   1.8473298401296  1.84204320025238
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  1.23150299808857  1.26110703952513  1.31359172056293
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out  1.10608052462494  1.14462111892475 0.990849252153732
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out 0.987796146118206 0.995821556838069 0.686212323034542
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out   1.4899569826427  1.48866583852698  1.41967708388251
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  1.46579268309207  1.45722866851363  2.32856705580899
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.945153313792086 0.842859605534413 0.721970880917249
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out 0.872700225739768 0.878598827909082 0.685243730902185
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out 0.945319629121382 0.959579656671636  1.09377652193263
##               hw_mul
## 1                NaN
## 2    1.2679087638248
## 3                NaN
## 4   1.61814948410176
## 5                NaN
## 6   1.78500014535895
## 7                NaN
## 8   1.16183997927205
## 9                NaN
## 10  0.86125672682618
## 11               NaN
## 12 0.702440627424316
## 13               NaN
## 14  1.40221584981471
## 15               NaN
## 16  2.13156450930606
## 17               NaN
## 18 0.783223727928355
## 19               NaN
## 20 0.743495441486405
## 21               NaN
## 22  1.10588551357609

es_G_MAE <- data.frame(fc_result_across(1)[1])

es_G_MAPE<- data.frame(fc_result_across(1)[2])


es_G_MASE<- data.frame(fc_result_across(1)[3]) %>% filter(row_number()%%2 ==0)
es_G_MASE<-txtRound(es_G_MASE[,-1],2)
es_G_MASE <- data.frame(forecast_period=fc_timestamp_out,es_G_MASE) 
htmlTable(es_G_MASE)

7.3.2 MLKEP

fc_result(2)

## $naive
##    forecast_period      MAE     MAPE
## 1    6m_Nov-Apr_in 35.92432 37.03705
## 2   6m_Nov-Apr_out 18.78453 26.12411
## 3    3m_Nov-Jan_in 35.92432 37.03705
## 4   3m_Nov-Jan_out 19.17391 29.66703
## 5    3m_Dec-Feb_in 33.79535 35.00399
## 6   3m_Dec-Feb_out 16.98889 27.86406
## 7    3m_Jan-Mar_in 32.08537 34.98210
## 8   3m_Jan-Mar_out 15.92222 22.51215
## 9    3m_Feb-Apr_in 30.36101 34.58924
## 10  3m_Feb-Apr_out 18.38202 22.46177
## 11       1m_Nov_in 35.92432 37.03705
## 12      1m_Nov_out 20.66667 22.46676
## 13       1m_Dec_in 33.79535 35.00399
## 14      1m_Dec_out 20.22581 34.83032
## 15       1m_Jan_in 32.08537 34.98210
## 16      1m_Jan_out 16.67742 31.47174
## 17       1m_Feb_in      NaN      NaN
## 18      1m_Feb_out 61.85714 72.01797
## 19       1m_Mar_in 28.83607 32.89712
## 20      1m_Mar_out 17.12903 19.29251
## 21       1m_Apr_in 27.75595 31.64194
## 22      1m_Apr_out 24.00000 31.62092
## 
## $ses
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 38.77455 0.6473017               NaN
## 2   6m_Nov-Apr_out 45.49341 0.6153640  2.42185488485271
## 3    3m_Nov-Jan_in 38.77455 0.6473017               NaN
## 4   3m_Nov-Jan_out 47.99566 0.7401124  2.50317495996648
## 5    3m_Dec-Feb_in 39.16804 0.6428962               NaN
## 6   3m_Dec-Feb_out 50.00241 1.1311959  2.94324218994747
## 7    3m_Jan-Mar_in 39.39255 0.6515307               NaN
## 8   3m_Jan-Mar_out 50.20995 0.5595839  3.15345143621606
## 9    3m_Feb-Apr_in 39.80263 0.6625364               NaN
## 10  3m_Feb-Apr_out 41.25520 0.5546310  2.24432329807167
## 11       1m_Nov_in 38.77455 0.6473017               NaN
## 12      1m_Nov_out 51.26677 0.4941932  2.48065023694255
## 13       1m_Dec_in 39.16804 0.6428962               NaN
## 14      1m_Dec_out 53.11451 1.1402568  2.62607600778802
## 15       1m_Jan_in 39.39255 0.6515307               NaN
## 16      1m_Jan_out 47.38678 0.7364310  2.84137377443743
## 17       1m_Feb_in 37.75368 0.6856247               NaN
## 18      1m_Feb_out 41.83729 0.6715170 0.676353494652262
## 19       1m_Mar_in 39.82918 0.6603712               NaN
## 20      1m_Mar_out 43.19087 0.5349947  2.52150109191934
## 21       1m_Apr_in 40.01951 0.6597906               NaN
## 22      1m_Apr_out 41.47564 0.6605126  1.72815186029591
## 
## $holt
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 38.77184 0.6530131               NaN
## 2   6m_Nov-Apr_out 45.18002 0.6353902  2.40517140567444
## 3    3m_Nov-Jan_in 38.77184 0.6530131               NaN
## 4   3m_Nov-Jan_out 48.14022 0.7608638  2.51071420616879
## 5    3m_Dec-Feb_in 39.15002 0.6521671               NaN
## 6   3m_Dec-Feb_out 51.81970 1.2004435  3.05021113893062
## 7    3m_Jan-Mar_in 39.39627 0.6538105               NaN
## 8   3m_Jan-Mar_out 50.49698 0.5582343  3.17147789239688
## 9    3m_Feb-Apr_in 39.80379 0.6674092               NaN
## 10  3m_Feb-Apr_out 40.99548 0.5695227  2.23019396058413
## 11       1m_Nov_in 38.77184 0.6530131               NaN
## 12      1m_Nov_out 51.00898 0.4954742  2.46817641736297
## 13       1m_Dec_in 39.15002 0.6521671               NaN
## 14      1m_Dec_out 54.45684 1.1848696  2.69244325136226
## 15       1m_Jan_in 39.39627 0.6538105               NaN
## 16      1m_Jan_out 47.48135 0.7317912  2.84704398921894
## 17       1m_Feb_in 39.80379 0.6674092               NaN
## 18      1m_Feb_out 38.40744 0.5613361 0.620905457428594
## 19       1m_Mar_in 39.83565 0.6656321               NaN
## 20      1m_Mar_out 42.83800 0.5384868  2.50090002175195
## 21       1m_Apr_in 40.02174 0.6658463               NaN
## 22      1m_Apr_out 41.52681 0.6709377  1.73028354206183
## 
## $hw_add
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 21.18071 0.3412081               NaN
## 2   6m_Nov-Apr_out 40.44032 0.5024606  2.15285208085992
## 3    3m_Nov-Jan_in 21.18071 0.3412081               NaN
## 4   3m_Nov-Jan_out 43.31319 0.5902200   2.2589643205019
## 5    3m_Dec-Feb_in 21.04567 0.3352257               NaN
## 6   3m_Dec-Feb_out 33.81385 0.8216322  1.99035089593933
## 7    3m_Jan-Mar_in 21.49253 0.3512270               NaN
## 8   3m_Jan-Mar_out 72.18988 0.9358860  4.53390757349255
## 9    3m_Feb-Apr_in 21.73913 0.3611149               NaN
## 10  3m_Feb-Apr_out 19.07638 0.2145234  1.03777373155899
## 11       1m_Nov_in 21.18071 0.3412081               NaN
## 12      1m_Nov_out 49.68810 0.4818548  2.40426284125621
## 13       1m_Dec_in 21.04567 0.3352257               NaN
## 14      1m_Dec_out 41.05527 1.0512742  2.02984596452465
## 15       1m_Jan_in 21.49253 0.3512270               NaN
## 16      1m_Jan_out 63.69622 0.9687336  3.81930887153841
## 17       1m_Feb_in 21.73913 0.3611149               NaN
## 18      1m_Feb_out 13.61814 0.1660205 0.220154760923705
## 19       1m_Mar_in 21.39390 0.3539051               NaN
## 20      1m_Mar_out 19.74626 0.1909887  1.15279466596787
## 21       1m_Apr_in 21.21729 0.3482126               NaN
## 22      1m_Apr_out 28.07609 0.3355028  1.16983687695675
## 
## $hw_mul
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 20.90222 0.3028179               NaN
## 2   6m_Nov-Apr_out 46.23437 0.4668452  2.46130027007225
## 3    3m_Nov-Jan_in 20.90222 0.3028179               NaN
## 4   3m_Nov-Jan_out 46.65270 0.5149623  2.43313398617843
## 5    3m_Dec-Feb_in 20.98880 0.2980816               NaN
## 6   3m_Dec-Feb_out 31.80701 0.7622298  1.87222417169747
## 7    3m_Jan-Mar_in 21.03735 0.3050282               NaN
## 8   3m_Jan-Mar_out 60.41168 0.5931100   3.7941741061251
## 9    3m_Feb-Apr_in 20.74706 0.3094236               NaN
## 10  3m_Feb-Apr_out 29.57399 0.2689125  1.60885381507066
## 11       1m_Nov_in 20.90222 0.3028179               NaN
## 12      1m_Nov_out 55.99825 0.4579445  2.70959288322267
## 13       1m_Dec_in 20.98880 0.2980816               NaN
## 14      1m_Dec_out 38.70986 0.9927841  1.91388482490275
## 15       1m_Jan_in 21.03735 0.3050282               NaN
## 16      1m_Jan_out 51.55298 0.5470016  3.09118460927018
## 17       1m_Feb_in 20.82137 0.3106785               NaN
## 18      1m_Feb_out 19.70531 0.1947078 0.318561626986709
## 19       1m_Mar_in 20.43778 0.3023790               NaN
## 20      1m_Mar_out 23.01562 0.2088241  1.34366115083376
## 21       1m_Apr_in 20.25453 0.2990208               NaN
## 22      1m_Apr_out 26.44477 0.2833986    1.101865510774

fc_result_across(2)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul
## 1    6m_Nov-Apr_in 38.77455 38.77184 21.18071 20.90222
## 2   6m_Nov-Apr_out 45.49341 45.18002 40.44032 46.23437
## 3    3m_Nov-Jan_in 38.77455 38.77184 21.18071 20.90222
## 4   3m_Nov-Jan_out 47.99566 48.14022 43.31319 46.65270
## 5    3m_Dec-Feb_in 39.16804 39.15002 21.04567 20.98880
## 6   3m_Dec-Feb_out 50.00241 51.81970 33.81385 31.80701
## 7    3m_Jan-Mar_in 39.39255 39.39627 21.49253 21.03735
## 8   3m_Jan-Mar_out 50.20995 50.49698 72.18988 60.41168
## 9    3m_Feb-Apr_in 39.80263 39.80379 21.73913 20.74706
## 10  3m_Feb-Apr_out 41.25520 40.99548 19.07638 29.57399
## 11       1m_Nov_in 38.77455 38.77184 21.18071 20.90222
## 12      1m_Nov_out 51.26677 51.00898 49.68810 55.99825
## 13       1m_Dec_in 39.16804 39.15002 21.04567 20.98880
## 14      1m_Dec_out 53.11451 54.45684 41.05527 38.70986
## 15       1m_Jan_in 39.39255 39.39627 21.49253 21.03735
## 16      1m_Jan_out 47.38678 47.48135 63.69622 51.55298
## 17       1m_Feb_in 37.75368 39.80379 21.73913 20.82137
## 18      1m_Feb_out 41.83729 38.40744 13.61814 19.70531
## 19       1m_Mar_in 39.82918 39.83565 21.39390 20.43778
## 20      1m_Mar_out 43.19087 42.83800 19.74626 23.01562
## 21       1m_Apr_in 40.01951 40.02174 21.21729 20.25453
## 22      1m_Apr_out 41.47564 41.52681 28.07609 26.44477
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul
## 1    6m_Nov-Apr_in 0.6473017 0.6530131 0.3412081 0.3028179
## 2   6m_Nov-Apr_out 0.6153640 0.6353902 0.5024606 0.4668452
## 3    3m_Nov-Jan_in 0.6473017 0.6530131 0.3412081 0.3028179
## 4   3m_Nov-Jan_out 0.7401124 0.7608638 0.5902200 0.5149623
## 5    3m_Dec-Feb_in 0.6428962 0.6521671 0.3352257 0.2980816
## 6   3m_Dec-Feb_out 1.1311959 1.2004435 0.8216322 0.7622298
## 7    3m_Jan-Mar_in 0.6515307 0.6538105 0.3512270 0.3050282
## 8   3m_Jan-Mar_out 0.5595839 0.5582343 0.9358860 0.5931100
## 9    3m_Feb-Apr_in 0.6625364 0.6674092 0.3611149 0.3094236
## 10  3m_Feb-Apr_out 0.5546310 0.5695227 0.2145234 0.2689125
## 11       1m_Nov_in 0.6473017 0.6530131 0.3412081 0.3028179
## 12      1m_Nov_out 0.4941932 0.4954742 0.4818548 0.4579445
## 13       1m_Dec_in 0.6428962 0.6521671 0.3352257 0.2980816
## 14      1m_Dec_out 1.1402568 1.1848696 1.0512742 0.9927841
## 15       1m_Jan_in 0.6515307 0.6538105 0.3512270 0.3050282
## 16      1m_Jan_out 0.7364310 0.7317912 0.9687336 0.5470016
## 17       1m_Feb_in 0.6856247 0.6674092 0.3611149 0.3106785
## 18      1m_Feb_out 0.6715170 0.5613361 0.1660205 0.1947078
## 19       1m_Mar_in 0.6603712 0.6656321 0.3539051 0.3023790
## 20      1m_Mar_out 0.5349947 0.5384868 0.1909887 0.2088241
## 21       1m_Apr_in 0.6597906 0.6658463 0.3482126 0.2990208
## 22      1m_Apr_out 0.6605126 0.6709377 0.3355028 0.2833986
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out  2.42185488485271  2.40517140567444  2.15285208085992
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  2.50317495996648  2.51071420616879   2.2589643205019
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  2.94324218994747  3.05021113893062  1.99035089593933
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  3.15345143621606  3.17147789239688  4.53390757349255
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out  2.24432329807167  2.23019396058413  1.03777373155899
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out  2.48065023694255  2.46817641736297  2.40426284125621
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out  2.62607600778802  2.69244325136226  2.02984596452465
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  2.84137377443743  2.84704398921894  3.81930887153841
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.676353494652262 0.620905457428594 0.220154760923705
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out  2.52150109191934  2.50090002175195  1.15279466596787
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out  1.72815186029591  1.73028354206183  1.16983687695675
##               hw_mul
## 1                NaN
## 2   2.46130027007225
## 3                NaN
## 4   2.43313398617843
## 5                NaN
## 6   1.87222417169747
## 7                NaN
## 8    3.7941741061251
## 9                NaN
## 10  1.60885381507066
## 11               NaN
## 12  2.70959288322267
## 13               NaN
## 14  1.91388482490275
## 15               NaN
## 16  3.09118460927018
## 17               NaN
## 18 0.318561626986709
## 19               NaN
## 20  1.34366115083376
## 21               NaN
## 22    1.101865510774

fc_result_across(2)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul
## 1    6m_Nov-Apr_in 38.77455 38.77184 21.18071 20.90222
## 2   6m_Nov-Apr_out 45.49341 45.18002 40.44032 46.23437
## 3    3m_Nov-Jan_in 38.77455 38.77184 21.18071 20.90222
## 4   3m_Nov-Jan_out 47.99566 48.14022 43.31319 46.65270
## 5    3m_Dec-Feb_in 39.16804 39.15002 21.04567 20.98880
## 6   3m_Dec-Feb_out 50.00241 51.81970 33.81385 31.80701
## 7    3m_Jan-Mar_in 39.39255 39.39627 21.49253 21.03735
## 8   3m_Jan-Mar_out 50.20995 50.49698 72.18988 60.41168
## 9    3m_Feb-Apr_in 39.80263 39.80379 21.73913 20.74706
## 10  3m_Feb-Apr_out 41.25520 40.99548 19.07638 29.57399
## 11       1m_Nov_in 38.77455 38.77184 21.18071 20.90222
## 12      1m_Nov_out 51.26677 51.00898 49.68810 55.99825
## 13       1m_Dec_in 39.16804 39.15002 21.04567 20.98880
## 14      1m_Dec_out 53.11451 54.45684 41.05527 38.70986
## 15       1m_Jan_in 39.39255 39.39627 21.49253 21.03735
## 16      1m_Jan_out 47.38678 47.48135 63.69622 51.55298
## 17       1m_Feb_in 37.75368 39.80379 21.73913 20.82137
## 18      1m_Feb_out 41.83729 38.40744 13.61814 19.70531
## 19       1m_Mar_in 39.82918 39.83565 21.39390 20.43778
## 20      1m_Mar_out 43.19087 42.83800 19.74626 23.01562
## 21       1m_Apr_in 40.01951 40.02174 21.21729 20.25453
## 22      1m_Apr_out 41.47564 41.52681 28.07609 26.44477
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul
## 1    6m_Nov-Apr_in 0.6473017 0.6530131 0.3412081 0.3028179
## 2   6m_Nov-Apr_out 0.6153640 0.6353902 0.5024606 0.4668452
## 3    3m_Nov-Jan_in 0.6473017 0.6530131 0.3412081 0.3028179
## 4   3m_Nov-Jan_out 0.7401124 0.7608638 0.5902200 0.5149623
## 5    3m_Dec-Feb_in 0.6428962 0.6521671 0.3352257 0.2980816
## 6   3m_Dec-Feb_out 1.1311959 1.2004435 0.8216322 0.7622298
## 7    3m_Jan-Mar_in 0.6515307 0.6538105 0.3512270 0.3050282
## 8   3m_Jan-Mar_out 0.5595839 0.5582343 0.9358860 0.5931100
## 9    3m_Feb-Apr_in 0.6625364 0.6674092 0.3611149 0.3094236
## 10  3m_Feb-Apr_out 0.5546310 0.5695227 0.2145234 0.2689125
## 11       1m_Nov_in 0.6473017 0.6530131 0.3412081 0.3028179
## 12      1m_Nov_out 0.4941932 0.4954742 0.4818548 0.4579445
## 13       1m_Dec_in 0.6428962 0.6521671 0.3352257 0.2980816
## 14      1m_Dec_out 1.1402568 1.1848696 1.0512742 0.9927841
## 15       1m_Jan_in 0.6515307 0.6538105 0.3512270 0.3050282
## 16      1m_Jan_out 0.7364310 0.7317912 0.9687336 0.5470016
## 17       1m_Feb_in 0.6856247 0.6674092 0.3611149 0.3106785
## 18      1m_Feb_out 0.6715170 0.5613361 0.1660205 0.1947078
## 19       1m_Mar_in 0.6603712 0.6656321 0.3539051 0.3023790
## 20      1m_Mar_out 0.5349947 0.5384868 0.1909887 0.2088241
## 21       1m_Apr_in 0.6597906 0.6658463 0.3482126 0.2990208
## 22      1m_Apr_out 0.6605126 0.6709377 0.3355028 0.2833986
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out  2.42185488485271  2.40517140567444  2.15285208085992
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  2.50317495996648  2.51071420616879   2.2589643205019
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  2.94324218994747  3.05021113893062  1.99035089593933
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  3.15345143621606  3.17147789239688  4.53390757349255
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out  2.24432329807167  2.23019396058413  1.03777373155899
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out  2.48065023694255  2.46817641736297  2.40426284125621
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out  2.62607600778802  2.69244325136226  2.02984596452465
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  2.84137377443743  2.84704398921894  3.81930887153841
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.676353494652262 0.620905457428594 0.220154760923705
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out  2.52150109191934  2.50090002175195  1.15279466596787
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out  1.72815186029591  1.73028354206183  1.16983687695675
##               hw_mul
## 1                NaN
## 2   2.46130027007225
## 3                NaN
## 4   2.43313398617843
## 5                NaN
## 6   1.87222417169747
## 7                NaN
## 8    3.7941741061251
## 9                NaN
## 10  1.60885381507066
## 11               NaN
## 12  2.70959288322267
## 13               NaN
## 14  1.91388482490275
## 15               NaN
## 16  3.09118460927018
## 17               NaN
## 18 0.318561626986709
## 19               NaN
## 20  1.34366115083376
## 21               NaN
## 22    1.101865510774

es_M_MAE <- data.frame(fc_result_across(2)[1])



es_M_MAPE<- data.frame(fc_result_across(2)[2])


es_M_MASE<- data.frame(fc_result_across(2)[3]) %>% filter(row_number()%%2 ==0)
es_M_MASE<-txtRound(es_M_MASE[,-1],2)
es_M_MASE <- data.frame(forecast_period=fc_timestamp_out,es_M_MASE) 
htmlTable(es_M_MASE)

7.3.3 WARUK

7.3.4 forecast accuracy by models

fc_result(3)

## $naive
##    forecast_period      MAE     MAPE
## 1    6m_Nov-Apr_in 21.16216 33.42249
## 2   6m_Nov-Apr_out 22.19337 51.94556
## 3    3m_Nov-Jan_in 21.16216 33.42249
## 4   3m_Nov-Jan_out 23.32609 60.52735
## 5    3m_Dec-Feb_in 21.95814 35.56006
## 6   3m_Dec-Feb_out 18.98889 53.19512
## 7    3m_Jan-Mar_in 22.45528 41.15430
## 8   3m_Jan-Mar_out 16.24444 35.18347
## 9    3m_Feb-Apr_in 21.88087 42.42482
## 10  3m_Feb-Apr_out 21.02247 43.07450
## 11       1m_Nov_in 21.16216 33.42249
## 12      1m_Nov_out 26.86667 48.74176
## 13       1m_Dec_in 21.95814 35.56006
## 14      1m_Dec_out 25.90323 79.95303
## 15       1m_Jan_in 22.45528 41.15430
## 16      1m_Jan_out 17.32258 52.50706
## 17       1m_Feb_in      NaN      NaN
## 18      1m_Feb_out 47.03571 93.55047
## 19       1m_Mar_in 21.08197 40.76385
## 20      1m_Mar_out 17.93548 27.66112
## 21       1m_Apr_in 20.79167 39.55497
## 22      1m_Apr_out 31.53333 76.49458
## 
## $ses
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 28.82098 0.5909103               NaN
## 2   6m_Nov-Apr_out 29.13186 0.9553429   1.3126381075586
## 3    3m_Nov-Jan_in 28.82098 0.5909103               NaN
## 4   3m_Nov-Jan_out 33.14034 1.2042130  1.42074162101984
## 5    3m_Dec-Feb_in 28.91952 0.6010551               NaN
## 6   3m_Dec-Feb_out 30.47796 1.0926923  1.60504186201305
## 7    3m_Jan-Mar_in 28.77723 0.6208548               NaN
## 8   3m_Jan-Mar_out 28.96293 0.5738793  1.78294381881824
## 9    3m_Feb-Apr_in 28.64621 0.6265531               NaN
## 10  3m_Feb-Apr_out 27.11680 0.5314595   1.2898960615447
## 11       1m_Nov_in 28.82098 0.5909103               NaN
## 12      1m_Nov_out 30.12265 0.7882818  1.12119051317152
## 13       1m_Dec_in 28.91952 0.6010551               NaN
## 14      1m_Dec_out 31.30868 1.2925213  1.20867897915411
## 15       1m_Jan_in 28.77723 0.6208548               NaN
## 16      1m_Jan_out 26.23703 0.7778604  1.51461459948899
## 17       1m_Feb_in 28.89159 0.5640120               NaN
## 18      1m_Feb_out 25.39501 0.4730915 0.539909198327349
## 19       1m_Mar_in 28.55806 0.6216608               NaN
## 20      1m_Mar_out 23.27438 0.4550559  1.29767225528038
## 21       1m_Apr_in 28.29187 0.6148704               NaN
## 22      1m_Apr_out 27.20959 0.9348579 0.862883557035178
## 
## $holt
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 28.79836 0.5821914               NaN
## 2   6m_Nov-Apr_out 28.22814 0.8959336  1.27191747493191
## 3    3m_Nov-Jan_in 28.79836 0.5821914               NaN
## 4   3m_Nov-Jan_out 31.89648 1.1336424  1.36741660311895
## 5    3m_Dec-Feb_in 28.90371 0.5917624               NaN
## 6   3m_Dec-Feb_out 29.87686 1.0544110  1.57338646187902
## 7    3m_Jan-Mar_in 28.70823 0.6078258               NaN
## 8   3m_Jan-Mar_out 31.91232 0.5461635  1.96450677908921
## 9    3m_Feb-Apr_in 28.54008 0.6119436               NaN
## 10  3m_Feb-Apr_out 27.87490 0.5255231  1.32595706973114
## 11       1m_Nov_in 28.79836 0.5821914               NaN
## 12      1m_Nov_out 29.93947 0.7553887  1.11437240413335
## 13       1m_Dec_in 28.90371 0.5917624               NaN
## 14      1m_Dec_out 30.63154 1.2530115  1.18253756938824
## 15       1m_Jan_in 28.70823 0.6078258               NaN
## 16      1m_Jan_out 25.05556 0.6536619   1.4464104266271
## 17       1m_Feb_in 28.54008 0.6119436               NaN
## 18      1m_Feb_out 27.76141 0.4712047 0.590219869373757
## 19       1m_Mar_in 28.45956 0.6096108               NaN
## 20      1m_Mar_out 23.27199 0.4559024  1.29753915255108
## 21       1m_Apr_in 28.20198 0.6046627               NaN
## 22      1m_Apr_out 27.45437 0.9482544 0.870646128538007
## 
## $hw_add
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 19.16986 0.3505977               NaN
## 2   6m_Nov-Apr_out 20.94382 0.5997629 0.943697112193449
## 3    3m_Nov-Jan_in 19.16986 0.3505977               NaN
## 4   3m_Nov-Jan_out 23.93825 0.8104840  1.02624367542471
## 5    3m_Dec-Feb_in 19.09842 0.3515533               NaN
## 6   3m_Dec-Feb_out 23.55038 0.8333053  1.24021917817597
## 7    3m_Jan-Mar_in 19.31966 0.3814761               NaN
## 8   3m_Jan-Mar_out 30.96454 0.5191572  1.90616194938938
## 9    3m_Feb-Apr_in 19.02623 0.3763300               NaN
## 10  3m_Feb-Apr_out 17.72514 0.3558995 0.843151851359788
## 11       1m_Nov_in 19.16986 0.3505977               NaN
## 12      1m_Nov_out 19.17861 0.3820458  0.71384406279644
## 13       1m_Dec_in 19.09842 0.3515533               NaN
## 14      1m_Dec_out 30.23650 1.2707635  1.16728704340749
## 15       1m_Jan_in 19.31966 0.3814761               NaN
## 16      1m_Jan_out 21.53150 0.4571971  1.24297305019322
## 17       1m_Feb_in 19.02623 0.3763300               NaN
## 18      1m_Feb_out 16.25180 0.2449163  0.34552033919289
## 19       1m_Mar_in 19.04268 0.3745319               NaN
## 20      1m_Mar_out 15.59887 0.2468240 0.869721349584206
## 21       1m_Apr_in 18.85216 0.3689643               NaN
## 22      1m_Apr_out 17.78947 0.6148652 0.564148231682622
## 
## $hw_mul
##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 19.36768 0.3553212               NaN
## 2   6m_Nov-Apr_out 21.78586 0.6848645 0.981638060456886
## 3    3m_Nov-Jan_in 19.36768 0.3553212               NaN
## 4   3m_Nov-Jan_out 25.33373 0.9187168  1.08606865222246
## 5    3m_Dec-Feb_in 19.28285 0.3578109               NaN
## 6   3m_Dec-Feb_out 23.37988 0.8281398  1.23123977404581
## 7    3m_Jan-Mar_in 19.52529 0.3877467               NaN
## 8   3m_Jan-Mar_out 24.38654 0.4169745  1.50122333299401
## 9    3m_Feb-Apr_in 19.36195 0.3857044               NaN
## 10  3m_Feb-Apr_out 19.19334 0.3592458 0.912991470803143
## 11       1m_Nov_in 19.36768 0.3553212               NaN
## 12      1m_Nov_out 18.43681 0.4285194 0.686233451964408
## 13       1m_Dec_in 19.28285 0.3578109               NaN
## 14      1m_Dec_out 30.10730 1.2717348  1.16229916161656
## 15       1m_Jan_in 19.52529 0.3877467               NaN
## 16      1m_Jan_out 19.87277 0.4746228  1.14721773195554
## 17       1m_Feb_in 19.35917 0.3856014               NaN
## 18      1m_Feb_out 17.38830 0.2507572 0.369682990947948
## 19       1m_Mar_in 19.30929 0.3815645               NaN
## 20      1m_Mar_out 15.90344 0.2447211  0.88670257462673
## 21       1m_Apr_in 19.13959 0.3752048               NaN
## 22      1m_Apr_out 17.83321 0.6452088 0.565535116533899

7.3.5 forecast accuracy across models

fc_result_across(3)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul
## 1    6m_Nov-Apr_in 28.82098 28.79836 19.16986 19.36768
## 2   6m_Nov-Apr_out 29.13186 28.22814 20.94382 21.78586
## 3    3m_Nov-Jan_in 28.82098 28.79836 19.16986 19.36768
## 4   3m_Nov-Jan_out 33.14034 31.89648 23.93825 25.33373
## 5    3m_Dec-Feb_in 28.91952 28.90371 19.09842 19.28285
## 6   3m_Dec-Feb_out 30.47796 29.87686 23.55038 23.37988
## 7    3m_Jan-Mar_in 28.77723 28.70823 19.31966 19.52529
## 8   3m_Jan-Mar_out 28.96293 31.91232 30.96454 24.38654
## 9    3m_Feb-Apr_in 28.64621 28.54008 19.02623 19.36195
## 10  3m_Feb-Apr_out 27.11680 27.87490 17.72514 19.19334
## 11       1m_Nov_in 28.82098 28.79836 19.16986 19.36768
## 12      1m_Nov_out 30.12265 29.93947 19.17861 18.43681
## 13       1m_Dec_in 28.91952 28.90371 19.09842 19.28285
## 14      1m_Dec_out 31.30868 30.63154 30.23650 30.10730
## 15       1m_Jan_in 28.77723 28.70823 19.31966 19.52529
## 16      1m_Jan_out 26.23703 25.05556 21.53150 19.87277
## 17       1m_Feb_in 28.89159 28.54008 19.02623 19.35917
## 18      1m_Feb_out 25.39501 27.76141 16.25180 17.38830
## 19       1m_Mar_in 28.55806 28.45956 19.04268 19.30929
## 20      1m_Mar_out 23.27438 23.27199 15.59887 15.90344
## 21       1m_Apr_in 28.29187 28.20198 18.85216 19.13959
## 22      1m_Apr_out 27.20959 27.45437 17.78947 17.83321
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul
## 1    6m_Nov-Apr_in 0.5909103 0.5821914 0.3505977 0.3553212
## 2   6m_Nov-Apr_out 0.9553429 0.8959336 0.5997629 0.6848645
## 3    3m_Nov-Jan_in 0.5909103 0.5821914 0.3505977 0.3553212
## 4   3m_Nov-Jan_out 1.2042130 1.1336424 0.8104840 0.9187168
## 5    3m_Dec-Feb_in 0.6010551 0.5917624 0.3515533 0.3578109
## 6   3m_Dec-Feb_out 1.0926923 1.0544110 0.8333053 0.8281398
## 7    3m_Jan-Mar_in 0.6208548 0.6078258 0.3814761 0.3877467
## 8   3m_Jan-Mar_out 0.5738793 0.5461635 0.5191572 0.4169745
## 9    3m_Feb-Apr_in 0.6265531 0.6119436 0.3763300 0.3857044
## 10  3m_Feb-Apr_out 0.5314595 0.5255231 0.3558995 0.3592458
## 11       1m_Nov_in 0.5909103 0.5821914 0.3505977 0.3553212
## 12      1m_Nov_out 0.7882818 0.7553887 0.3820458 0.4285194
## 13       1m_Dec_in 0.6010551 0.5917624 0.3515533 0.3578109
## 14      1m_Dec_out 1.2925213 1.2530115 1.2707635 1.2717348
## 15       1m_Jan_in 0.6208548 0.6078258 0.3814761 0.3877467
## 16      1m_Jan_out 0.7778604 0.6536619 0.4571971 0.4746228
## 17       1m_Feb_in 0.5640120 0.6119436 0.3763300 0.3856014
## 18      1m_Feb_out 0.4730915 0.4712047 0.2449163 0.2507572
## 19       1m_Mar_in 0.6216608 0.6096108 0.3745319 0.3815645
## 20      1m_Mar_out 0.4550559 0.4559024 0.2468240 0.2447211
## 21       1m_Apr_in 0.6148704 0.6046627 0.3689643 0.3752048
## 22      1m_Apr_out 0.9348579 0.9482544 0.6148652 0.6452088
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out   1.3126381075586  1.27191747493191 0.943697112193449
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  1.42074162101984  1.36741660311895  1.02624367542471
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  1.60504186201305  1.57338646187902  1.24021917817597
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  1.78294381881824  1.96450677908921  1.90616194938938
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out   1.2898960615447  1.32595706973114 0.843151851359788
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out  1.12119051317152  1.11437240413335  0.71384406279644
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out  1.20867897915411  1.18253756938824  1.16728704340749
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  1.51461459948899   1.4464104266271  1.24297305019322
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.539909198327349 0.590219869373757  0.34552033919289
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out  1.29767225528038  1.29753915255108 0.869721349584206
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out 0.862883557035178 0.870646128538007 0.564148231682622
##               hw_mul
## 1                NaN
## 2  0.981638060456886
## 3                NaN
## 4   1.08606865222246
## 5                NaN
## 6   1.23123977404581
## 7                NaN
## 8   1.50122333299401
## 9                NaN
## 10 0.912991470803143
## 11               NaN
## 12 0.686233451964408
## 13               NaN
## 14  1.16229916161656
## 15               NaN
## 16  1.14721773195554
## 17               NaN
## 18 0.369682990947948
## 19               NaN
## 20  0.88670257462673
## 21               NaN
## 22 0.565535116533899

fc_timestamp_out_order<-c("1m_Nov_out","1m_Dec_out","1m_Jan_out","1m_Feb_out","1m_Mar_out","1m_Apr_out","3m_Nov-Jan_out","3m_Dec-Feb_out","3m_Jan-Mar_out","3m_Feb-Apr_out","6m_Nov-Apr_out")

fc_result_across(3)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul
## 1    6m_Nov-Apr_in 28.82098 28.79836 19.16986 19.36768
## 2   6m_Nov-Apr_out 29.13186 28.22814 20.94382 21.78586
## 3    3m_Nov-Jan_in 28.82098 28.79836 19.16986 19.36768
## 4   3m_Nov-Jan_out 33.14034 31.89648 23.93825 25.33373
## 5    3m_Dec-Feb_in 28.91952 28.90371 19.09842 19.28285
## 6   3m_Dec-Feb_out 30.47796 29.87686 23.55038 23.37988
## 7    3m_Jan-Mar_in 28.77723 28.70823 19.31966 19.52529
## 8   3m_Jan-Mar_out 28.96293 31.91232 30.96454 24.38654
## 9    3m_Feb-Apr_in 28.64621 28.54008 19.02623 19.36195
## 10  3m_Feb-Apr_out 27.11680 27.87490 17.72514 19.19334
## 11       1m_Nov_in 28.82098 28.79836 19.16986 19.36768
## 12      1m_Nov_out 30.12265 29.93947 19.17861 18.43681
## 13       1m_Dec_in 28.91952 28.90371 19.09842 19.28285
## 14      1m_Dec_out 31.30868 30.63154 30.23650 30.10730
## 15       1m_Jan_in 28.77723 28.70823 19.31966 19.52529
## 16      1m_Jan_out 26.23703 25.05556 21.53150 19.87277
## 17       1m_Feb_in 28.89159 28.54008 19.02623 19.35917
## 18      1m_Feb_out 25.39501 27.76141 16.25180 17.38830
## 19       1m_Mar_in 28.55806 28.45956 19.04268 19.30929
## 20      1m_Mar_out 23.27438 23.27199 15.59887 15.90344
## 21       1m_Apr_in 28.29187 28.20198 18.85216 19.13959
## 22      1m_Apr_out 27.20959 27.45437 17.78947 17.83321
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul
## 1    6m_Nov-Apr_in 0.5909103 0.5821914 0.3505977 0.3553212
## 2   6m_Nov-Apr_out 0.9553429 0.8959336 0.5997629 0.6848645
## 3    3m_Nov-Jan_in 0.5909103 0.5821914 0.3505977 0.3553212
## 4   3m_Nov-Jan_out 1.2042130 1.1336424 0.8104840 0.9187168
## 5    3m_Dec-Feb_in 0.6010551 0.5917624 0.3515533 0.3578109
## 6   3m_Dec-Feb_out 1.0926923 1.0544110 0.8333053 0.8281398
## 7    3m_Jan-Mar_in 0.6208548 0.6078258 0.3814761 0.3877467
## 8   3m_Jan-Mar_out 0.5738793 0.5461635 0.5191572 0.4169745
## 9    3m_Feb-Apr_in 0.6265531 0.6119436 0.3763300 0.3857044
## 10  3m_Feb-Apr_out 0.5314595 0.5255231 0.3558995 0.3592458
## 11       1m_Nov_in 0.5909103 0.5821914 0.3505977 0.3553212
## 12      1m_Nov_out 0.7882818 0.7553887 0.3820458 0.4285194
## 13       1m_Dec_in 0.6010551 0.5917624 0.3515533 0.3578109
## 14      1m_Dec_out 1.2925213 1.2530115 1.2707635 1.2717348
## 15       1m_Jan_in 0.6208548 0.6078258 0.3814761 0.3877467
## 16      1m_Jan_out 0.7778604 0.6536619 0.4571971 0.4746228
## 17       1m_Feb_in 0.5640120 0.6119436 0.3763300 0.3856014
## 18      1m_Feb_out 0.4730915 0.4712047 0.2449163 0.2507572
## 19       1m_Mar_in 0.6216608 0.6096108 0.3745319 0.3815645
## 20      1m_Mar_out 0.4550559 0.4559024 0.2468240 0.2447211
## 21       1m_Apr_in 0.6148704 0.6046627 0.3689643 0.3752048
## 22      1m_Apr_out 0.9348579 0.9482544 0.6148652 0.6452088
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out   1.3126381075586  1.27191747493191 0.943697112193449
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  1.42074162101984  1.36741660311895  1.02624367542471
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  1.60504186201305  1.57338646187902  1.24021917817597
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  1.78294381881824  1.96450677908921  1.90616194938938
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out   1.2898960615447  1.32595706973114 0.843151851359788
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out  1.12119051317152  1.11437240413335  0.71384406279644
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out  1.20867897915411  1.18253756938824  1.16728704340749
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  1.51461459948899   1.4464104266271  1.24297305019322
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.539909198327349 0.590219869373757  0.34552033919289
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out  1.29767225528038  1.29753915255108 0.869721349584206
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out 0.862883557035178 0.870646128538007 0.564148231682622
##               hw_mul
## 1                NaN
## 2  0.981638060456886
## 3                NaN
## 4   1.08606865222246
## 5                NaN
## 6   1.23123977404581
## 7                NaN
## 8   1.50122333299401
## 9                NaN
## 10 0.912991470803143
## 11               NaN
## 12 0.686233451964408
## 13               NaN
## 14  1.16229916161656
## 15               NaN
## 16  1.14721773195554
## 17               NaN
## 18 0.369682990947948
## 19               NaN
## 20  0.88670257462673
## 21               NaN
## 22 0.565535116533899

es_W_MAE <- data.frame(fc_result_across(3)[1])


es_W_MAPE<- data.frame(fc_result_across(3)[2])


es_W_MASE<- data.frame(fc_result_across(3)[3]) %>% filter(row_number()%%2 ==0)
es_W_MASE<-txtRound(es_W_MASE[,-1],2)
es_W_MASE <- data.frame(forecast_period=fc_timestamp_out,es_W_MASE) 
htmlTable(es_W_MASE)

ses_alpha <- function(hotel_no) {
## six-month forecasting errors
six_month_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") 

## three-month forecasting errors
three_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") 
three_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") 
three_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") 
three_month_4_ses <-fc_ses("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") 

## one-month forecasting errors
one_month_1_ses <-fc_ses("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") 
one_month_2_ses <-fc_ses("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") 
one_month_3_ses <-fc_ses("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31")  
one_month_4_ses <-fc_ses("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28")  
one_month_5_ses <-fc_ses("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") 
one_month_6_ses <-fc_ses("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") 

ses_alpha<-rbind(round(six_month_ses$model$par[1],3),round(three_month_1_ses$model$par[1],3),round(three_month_2_ses$model$par[1],3),round(three_month_3_ses$model$par[1],3),round(three_month_4_ses$model$par[1],3),round(one_month_1_ses$model$par[1],3),round(one_month_2_ses$model$par[1],3),round(one_month_3_ses$model$par[1],3),round(one_month_4_ses$model$par[1],3),round(one_month_5_ses$model$par[1],3),round(one_month_6_ses$model$par[1],3))

 return(ses_alpha)
}

ses_alpha(1)

##       alpha
##  [1,] 0.188
##  [2,] 0.188
##  [3,] 0.184
##  [4,] 0.199
##  [5,] 0.211
##  [6,] 0.188
##  [7,] 0.184
##  [8,] 0.199
##  [9,] 0.253
## [10,] 0.213
## [11,] 0.206

ses_alpha(2)

##       alpha
##  [1,] 0.086
##  [2,] 0.086
##  [3,] 0.084
##  [4,] 0.107
##  [5,] 0.108
##  [6,] 0.086
##  [7,] 0.084
##  [8,] 0.107
##  [9,] 0.132
## [10,] 0.103
## [11,] 0.096

ses_alpha(3)

##       alpha
##  [1,] 0.044
##  [2,] 0.044
##  [3,] 0.043
##  [4,] 0.052
##  [5,] 0.053
##  [6,] 0.044
##  [7,] 0.043
##  [8,] 0.052
##  [9,] 0.053
## [10,] 0.054
## [11,] 0.054

ses_alpha_3.df<- data.frame(alpha_G =ses_alpha(1)[,1], alpha_M =ses_alpha(2)[,1],alpha_W=ses_alpha(3)[,1]) 

ses_alpha_3 <-data.frame(forecast_period = fc_timestamp_out, ses_alpha_3.df)
htmlTable(ses_alpha_3)

holt_alphabeta<- function(hotel_no) {
## six-month forecasting errors
six_month_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") 

## three-month forecasting errors
three_month_1_holt <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") 
three_month_2_holt <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28") 
three_month_3_holt  <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") 
three_month_4_holt  <-fc_holt("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") 

## one-month forecasting errors
one_month_1_holt  <-fc_holt("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") 
one_month_2_holt  <-fc_holt("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") 
one_month_3_holt  <-fc_holt("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31")  
one_month_4_holt  <-fc_holt("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28")  
one_month_5_holt <-fc_holt("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") 
one_month_6_holt  <-fc_holt("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") 

holt_alphabeta<-rbind(round(six_month_holt$model$par[1:2],4),round(three_month_1_holt$model$par[1:2],4),round(three_month_2_holt$model$par[1:2],4),round(three_month_3_holt$model$par[1:2],4),round(three_month_4_holt$model$par[1:2],4),round(one_month_1_holt$model$par[1:2],4),round(one_month_2_holt$model$par[1:2],4),round(one_month_3_holt$model$par[1:2],4),round(one_month_4_holt$model$par[1:2],4),round(one_month_5_holt$model$par[1:2],4),round(one_month_6_holt$model$par[1:2],4))

 return(holt_alphabeta)
}

holt_alphabeta(1)

##        alpha  beta
##  [1,] 0.1921 1e-04
##  [2,] 0.1921 1e-04
##  [3,] 0.1882 1e-04
##  [4,] 0.2024 1e-04
##  [5,] 0.2142 1e-04
##  [6,] 0.1921 1e-04
##  [7,] 0.1882 1e-04
##  [8,] 0.2024 1e-04
##  [9,] 0.2572 1e-04
## [10,] 0.2158 1e-04
## [11,] 0.2084 1e-04

holt_alphabeta(2)

##        alpha  beta
##  [1,] 0.0881 1e-04
##  [2,] 0.0881 1e-04
##  [3,] 0.0844 1e-04
##  [4,] 0.1093 1e-04
##  [5,] 0.1104 1e-04
##  [6,] 0.0881 1e-04
##  [7,] 0.0844 1e-04
##  [8,] 0.1093 1e-04
##  [9,] 0.1328 1e-04
## [10,] 0.1052 1e-04
## [11,] 0.0982 1e-04

holt_alphabeta(3)

##        alpha  beta
##  [1,] 0.0634 1e-04
##  [2,] 0.0634 1e-04
##  [3,] 0.0612 1e-04
##  [4,] 0.0681 1e-04
##  [5,] 0.0685 1e-04
##  [6,] 0.0634 1e-04
##  [7,] 0.0612 1e-04
##  [8,] 0.0681 1e-04
##  [9,] 0.0815 1e-04
## [10,] 0.0699 1e-04
## [11,] 0.0691 1e-04

holt_alphabeta_3.df <- data.frame(alpha__G =holt_alphabeta(1)[,1], beta__G =holt_alphabeta(1)[,2],alpha_M =holt_alphabeta(2)[,1],beta_M =holt_alphabeta(2)[,2],alpha_W=holt_alphabeta(3)[,1],beta_W=holt_alphabeta(3)[,2]) 
holt_alphabeta_3 <-data.frame(forecast_period = fc_timestamp_out, holt_alphabeta_3.df)
htmlTable(holt_alphabeta_3 )

png(filename="holt_alphabeta_3.png")

hw_add_abg<- function(hotel_no) {
## six-month forecasting errors
six_month_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","additive") 

## three-month forecasting errors
three_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31","additive") 
three_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28","additive") 
three_month_3_hw  <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31","additive") 
three_month_4_hw  <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30","additive") 

## one-month forecasting errors
one_month_1_hw  <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30","additive") 
one_month_2_hw  <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31","additive") 
one_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31","additive")  
one_month_4_hw  <-fc_hw("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28","additive")  
one_month_5_hw <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31","additive") 
one_month_6_hw  <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30","additive") 

hw_add_abg<-rbind(round(six_month_hw$model$par[1:3],4),round(three_month_1_hw$model$par[1:3],4),round(three_month_2_hw$model$par[1:3],4),round(three_month_3_hw$model$par[1:3],4),round(three_month_4_hw$model$par[1:3],4),round(one_month_1_hw$model$par[1:3],4),round(one_month_2_hw$model$par[1:3],4),round(one_month_3_hw$model$par[1:3],4),round(one_month_4_hw$model$par[1:3],4),round(one_month_5_hw$model$par[1:3],4),round(one_month_6_hw$model$par[1:3],4))

 return(hw_add_abg)
}

hw_add_abg(1)

##        alpha  beta gamma
##  [1,] 0.4651 1e-04 1e-04
##  [2,] 0.4651 1e-04 1e-04
##  [3,] 0.4676 1e-04 1e-04
##  [4,] 0.5012 1e-04 1e-04
##  [5,] 0.4832 1e-04 2e-04
##  [6,] 0.4651 1e-04 1e-04
##  [7,] 0.4676 1e-04 1e-04
##  [8,] 0.5012 1e-04 1e-04
##  [9,] 0.5251 1e-04 1e-04
## [10,] 0.4711 1e-04 2e-04
## [11,] 0.4631 1e-04 1e-04

hw_add_abg(2)

##        alpha  beta gamma
##  [1,] 0.4400 1e-04 1e-04
##  [2,] 0.4400 1e-04 1e-04
##  [3,] 0.4203 1e-04 2e-04
##  [4,] 0.4626 1e-04 1e-04
##  [5,] 0.4641 1e-04 1e-04
##  [6,] 0.4400 1e-04 1e-04
##  [7,] 0.4203 1e-04 2e-04
##  [8,] 0.4626 1e-04 1e-04
##  [9,] 0.4881 1e-04 2e-04
## [10,] 0.4760 1e-04 1e-04
## [11,] 0.4568 1e-04 1e-04

hw_add_abg(3)

##        alpha  beta  gamma
##  [1,] 0.0770 1e-04 0.1040
##  [2,] 0.0770 1e-04 0.1040
##  [3,] 0.0674 1e-04 0.1352
##  [4,] 0.0868 1e-04 0.1379
##  [5,] 0.0995 1e-04 0.1485
##  [6,] 0.0770 1e-04 0.1040
##  [7,] 0.0674 1e-04 0.1352
##  [8,] 0.0868 1e-04 0.1379
##  [9,] 0.1430 1e-04 0.0004
## [10,] 0.0962 1e-04 0.1388
## [11,] 0.0970 1e-04 0.1334

hw_add_abg_3.df <- data.frame(alpha_G =hw_add_abg(1)[,1], beta_G =hw_add_abg(1)[,2],gamma_G =hw_add_abg(1)[,3],alpha_M =hw_add_abg(2)[,1],beta_M =hw_add_abg(2)[,2],gamma_M =hw_add_abg(2)[,3],alpha_W=hw_add_abg(3)[,1],beta_W=hw_add_abg(3)[,2],gamma_W=hw_add_abg(3)[,3]) 

hw_add_abg_3 <-data.frame(forecast_period = fc_timestamp_out, hw_add_abg_3.df)
htmlTable(hw_add_abg_3)

hw_mul_abg<- function(hotel_no) {
## six-month forecasting errors
six_month_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30","multiplicative") 

## three-month forecasting errors
three_month_1_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31","multiplicative") 
three_month_2_hw <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28","multiplicative") 
three_month_3_hw  <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31","multiplicative") 
three_month_4_hw  <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30","multiplicative") 

## one-month forecasting errors
one_month_1_hw  <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30","multiplicative") 
one_month_2_hw  <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31","multiplicative") 
one_month_3_hw <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31","multiplicative")  
one_month_4_hw  <-fc_hw("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28","multiplicative")  
one_month_5_hw <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31","multiplicative") 
one_month_6_hw  <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30","multiplicative") 

hw_mul_abg<-rbind(round(six_month_hw$model$par[1:3],4),round(three_month_1_hw$model$par[1:3],4),round(three_month_2_hw$model$par[1:3],4),round(three_month_3_hw$model$par[1:3],4),round(three_month_4_hw$model$par[1:3],4),round(one_month_1_hw$model$par[1:3],4),round(one_month_2_hw$model$par[1:3],4),round(one_month_3_hw$model$par[1:3],4),round(one_month_4_hw$model$par[1:3],4),round(one_month_5_hw$model$par[1:3],4),round(one_month_6_hw$model$par[1:3],4))

 return(hw_mul_abg)
}

hw_mul_abg(1)

##        alpha  beta  gamma
##  [1,] 0.4008 1e-04 0.0001
##  [2,] 0.4008 1e-04 0.0001
##  [3,] 0.3818 1e-04 0.0001
##  [4,] 0.4472 1e-04 0.0001
##  [5,] 0.4455 1e-04 0.0001
##  [6,] 0.4008 1e-04 0.0001
##  [7,] 0.3818 1e-04 0.0001
##  [8,] 0.4472 1e-04 0.0001
##  [9,] 0.3814 1e-04 0.0001
## [10,] 0.4446 1e-04 0.0001
## [11,] 0.4228 1e-04 0.0054

hw_mul_abg(2)

##        alpha   beta  gamma
##  [1,] 0.5514 0.0011 0.0001
##  [2,] 0.5514 0.0011 0.0001
##  [3,] 0.4789 0.0001 0.0001
##  [4,] 0.4457 0.0001 0.0001
##  [5,] 0.5764 0.0042 0.0001
##  [6,] 0.5514 0.0011 0.0001
##  [7,] 0.4789 0.0001 0.0001
##  [8,] 0.4457 0.0001 0.0001
##  [9,] 0.5401 0.0001 0.0254
## [10,] 0.5719 0.0001 0.0001
## [11,] 0.5871 0.0010 0.0001

hw_mul_abg(3)

##        alpha  beta  gamma
##  [1,] 0.0339 1e-04 0.1513
##  [2,] 0.0339 1e-04 0.1513
##  [3,] 0.0298 1e-04 0.1586
##  [4,] 0.0508 1e-04 0.1447
##  [5,] 0.0602 1e-04 0.1517
##  [6,] 0.0339 1e-04 0.1513
##  [7,] 0.0298 1e-04 0.1586
##  [8,] 0.0508 1e-04 0.1447
##  [9,] 0.0980 1e-04 0.0432
## [10,] 0.0596 1e-04 0.1464
## [11,] 0.0591 1e-04 0.1407

hw_mul_abg_3 <- data.frame(alpha_G =hw_mul_abg(1)[,1], beta_G =hw_mul_abg(1)[,2],gamma_G =hw_mul_abg(1)[,3],alpha_M =hw_mul_abg(2)[,1],beta_M =hw_mul_abg(2)[,2],gamma_M =hw_mul_abg(2)[,3],alpha_W=hw_mul_abg(3)[,1],beta_W=hw_mul_abg(3)[,2],gamma_W=hw_mul_abg(3)[,3]) 
hw_mul_abg_3

##    alpha_G beta_G gamma_G alpha_M beta_M gamma_M alpha_W beta_W gamma_W
## 1   0.4008  1e-04  0.0001  0.5514 0.0011  0.0001  0.0339  1e-04  0.1513
## 2   0.4008  1e-04  0.0001  0.5514 0.0011  0.0001  0.0339  1e-04  0.1513
## 3   0.3818  1e-04  0.0001  0.4789 0.0001  0.0001  0.0298  1e-04  0.1586
## 4   0.4472  1e-04  0.0001  0.4457 0.0001  0.0001  0.0508  1e-04  0.1447
## 5   0.4455  1e-04  0.0001  0.5764 0.0042  0.0001  0.0602  1e-04  0.1517
## 6   0.4008  1e-04  0.0001  0.5514 0.0011  0.0001  0.0339  1e-04  0.1513
## 7   0.3818  1e-04  0.0001  0.4789 0.0001  0.0001  0.0298  1e-04  0.1586
## 8   0.4472  1e-04  0.0001  0.4457 0.0001  0.0001  0.0508  1e-04  0.1447
## 9   0.3814  1e-04  0.0001  0.5401 0.0001  0.0254  0.0980  1e-04  0.0432
## 10  0.4446  1e-04  0.0001  0.5719 0.0001  0.0001  0.0596  1e-04  0.1464
## 11  0.4228  1e-04  0.0054  0.5871 0.0010  0.0001  0.0591  1e-04  0.1407

hw_mul_abg_3 <-data.frame(forecast_period = fc_timestamp_out, hw_mul_abg_3)
htmlTable(hw_mul_abg_3)

8.2.1 create auto ARIMA model fitting function

# create auto ARIMA model fitting function
fc_auto.arima <- function(hotel_no) 
  {lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])
fc_ts <- auto.arima(in_sample_dataset_ts[,hotel_no],lambda =lambda)
return(fc_ts) 
}

8.2.2 create ARIMA model fitting function

# create ARIMA model fitting function
fc_Arima <- function(hotel_no,p,d,q) 
  {lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])
fc_ts <- Arima(in_sample_dataset_ts[,hotel_no],lambda =lambda,order = c(p,d,q))
return(fc_ts) 
}

8.2.3 create Seasonal ARIMA model fitting function

# create Seasonal ARIMA model fitting function
fc_SArima <- function(hotel_no,p,d,q,P,D,Q) 
  {lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])
fc_ts <- Arima(in_sample_dataset_ts[,hotel_no],lambda =lambda,order = c(p,d,q),seasonal=c(P,D,Q))
return(fc_ts) 
}

8.2.4 create Arima forecast error result function

# create Arima forecast result function
fc_Arima_error <- function(hotel_no,p,d,q) { 

# create snaive forecast function
fc_snaive <- function(time1,time2,hotel_no,time3,time4) { k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
training_ts <- subset(naive_dataset_ts,end=k)
fc_ts <- snaive(training_ts[,hotel_no], h = k1) %>% accuracy(naive_dataset_ts[,hotel_no]) 
return(fc_ts) 
}

# create ARIMA forecast function
fc_Arima <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q) { k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
training_ts <- subset(full_dataset_ts,end=k)
lambda <- BoxCox.lambda(training_ts[,hotel_no])
fc_ts <- Arima(training_ts [,hotel_no],lambda = lambda,order=c(p,d,q),method="CSS") %>% forecast(h = k1) %>% accuracy(full_dataset_ts[,hotel_no])
return(fc_ts) 
}

# naive model forecast
## six-month forecasting errors
six_month <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") 

## three-month forecasting errors
three_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") 
three_month_2  <-fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28")
three_month_3  <-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2009-01-01","2010-03-31")
three_month_4 <-fc_snaive("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") 

## one-month forecasting errors
one_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") 
one_month_2<- fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") 
one_month_3<-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") 
one_month_4<-fc_snaive("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28") 
one_month_5<-fc_snaive("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") 
one_month_6<-fc_snaive("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") 

# combine all the matrix
naive_result<-rbind(six_month,three_month_1,three_month_2,three_month_3,three_month_4,one_month_1,one_month_2,one_month_3,one_month_4,one_month_5,one_month_6)
# transfer to data frame and only keep test data result and MAE and MAPE
naive_result.df<- as.data.frame(naive_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2 ==1)
# rename the row name
naive_result<-data.frame(forecast_period= fc_timestamp, naive_result.df)

# Arima model forecast
## six-month forecasting errors

six_month_Arima <- fc_Arima(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30", p,d,q) 

## three-month forecasting errors
three_month_1_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q)  

three_month_2_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q)   

three_month_3_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q)   

three_month_4_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q)   

## one-month forecasting errors
one_month_1_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q)  
one_month_2_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q)  
one_month_3_Arima <-fc_Arima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q)  
one_month_4_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q)  
one_month_5_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q)  
one_month_6_Arima <-fc_Arima(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q)  

# combine all the matrix
arima_result <- rbind(six_month_Arima,three_month_1_Arima,three_month_2_Arima,three_month_3_Arima,three_month_4_Arima,one_month_1_Arima,one_month_2_Arima,one_month_3_Arima,one_month_4_Arima,one_month_5_Arima,one_month_6_Arima)
# transfer to data frame and only keep MAE and MAPE
arima_result.df<- as.data.frame(arima_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0|row_number()%%2==1)
# rename the row name
arima_result <- data.frame(forecast_period= fc_timestamp, arima_result.df)
# mutate MAPE as decimal number
arima_result <- arima_result %>% mutate(MAPE= MAPE/100)
# calculate MASE
arima_result  <- arima_result %>%mutate(MASE = as.matrix(arima_result["MAE"])/as.matrix(naive_result["MAE"]))
# remove MASE for in-sample
arima_result  <- arima_result  %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))

return(arima_result)
}

8.2.5 create SArima forecast error result function

#create Sarima forecast result function
fc_SArima_error <- function(hotel_no,p,d,q,P,D,Q) { 

# create snaive forecast function
fc_snaive <- function(time1,time2,hotel_no,time3,time4) { 
  k = abs(as.numeric(difftime(as.Date(time1), as.Date(time2), unit = "day"))) + 1
  k1= abs(as.numeric(difftime(as.Date(time3), as.Date(time4), unit = "day"))) + 1
  training_ts <- subset(naive_dataset_ts,end = k)
  fc_ts <- snaive(training_ts[,hotel_no], h = k1) %>% accuracy(naive_dataset_ts[,hotel_no]) 
  return(fc_ts) 
}

# create seasonal ARIMA forecast function
fc_Sarima <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q,P,D,Q) { 
  k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
  k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
  training_ts <- subset(full_dataset_ts,end = k)
  lambda <- BoxCox.lambda(training_ts)
  fc_ts <- Arima(training_ts [,hotel_no],lambda = lambda,order=c(p,d,q),seasonal = c(P,D,Q),method ="CSS") %>% forecast(h = k1) %>% accuracy(full_dataset_ts[,hotel_no])
return(fc_ts) 
}

# naive model forecast
# six-month forecasting errors
six_month <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30") 

# three-month forecasting errors
three_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31") 
three_month_2 <-fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28")  
three_month_3 <-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31") 
three_month_4 <-fc_snaive("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30") 

# one-month forecasting errors
one_month_1 <-fc_snaive("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30") 
one_month_2<- fc_snaive("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31") 
one_month_3<-fc_snaive("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31") 
one_month_4<-fc_snaive("2008-05-01","2009-01-31",hotel_no,"2010-02-01","2010-02-28") 
one_month_5<-fc_snaive("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31") 
one_month_6<-fc_snaive("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30") 

# combine all the matrix
naive_result<-rbind(six_month,three_month_1,three_month_2,three_month_3,three_month_4,one_month_1,one_month_2,one_month_3,one_month_4,one_month_5,one_month_6)
# transfer to data frame and only keep test data result and MAE and MAPE
naive_result.df<- as.data.frame(naive_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0 |row_number()%%2 ==1)
# rename the row name
naive_result<-data.frame(forecast_period= fc_timestamp, naive_result.df)

# SArima model forecast
## six-month forecasting errors

six_month_SArima <- fc_Sarima(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30",p,d,q,P,D,Q)


## three-month forecasting errors
three_month_1_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q,P,D,Q) 

three_month_2_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q,P,D,Q)  

three_month_3_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q,P,D,Q) 

three_month_4_SArima<-fc_Sarima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q,P,D,Q)    

## one-month forecasting errors
one_month_1_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q,P,D,Q)  
one_month_2_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q,P,D,Q)  
one_month_3_SArima <-fc_Sarima(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q,P,D,Q)  
one_month_4_SArima <-fc_Sarima(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q,P,D,Q)  
one_month_5_SArima <-fc_Sarima(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q,P,D,Q)  
one_month_6_SArima <-fc_Sarima(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q,P,D,Q)  

# combine all the matrix
Sarima_result<-rbind(six_month_SArima,three_month_1_SArima,three_month_2_SArima,three_month_3_SArima,three_month_4_SArima,one_month_1_SArima,one_month_2_SArima,one_month_3_SArima,one_month_4_SArima,one_month_5_SArima,one_month_6_SArima)
# transfer to data frame and only keep MAE and MAPE
Sarima_result.df<- as.data.frame(Sarima_result)%>%select("MAE","MAPE")%>%filter(row_number() %% 2 == 0|row_number()%%2==1)
# rename the row name
Sarima_result <-data.frame(forecast_period= fc_timestamp, Sarima_result.df)
# mutate MAPE as decimal number
Sarima_result  <- Sarima_result %>% mutate(MAPE= MAPE/100)
# calculate MASE
Sarima_result <- Sarima_result %>% mutate(MASE = as.matrix(Sarima_result["MAE"])/as.matrix(naive_result["MAE"]))
# remove MASE for in-sample
Sarima_result <- Sarima_result %>% mutate(MASE = ifelse(row_number() %%2 ==1,"NaN",MASE))

return(Sarima_result)
}

8.2.6 create MASE function for ARIMA and SARIMA

fc_result_arimasarima <- function(hotel_no,p,d,q,p_S,d_S,q_S,P,D,Q) {
         k<-fc_result(hotel_no)
         A<-fc_Arima_error (hotel_no,p,d,q)
         SA<-fc_SArima_error (hotel_no,p_S,d_S,q_S,P,D,Q)

  
  MASE <- data.frame(forecast_period=k[["naive"]][,1],Arima=A[,4],Sarima=SA[,4])
  
  return(list(MASE=MASE))
}

8.2.7 create Arima 95% prediction comparison function

fc_Arima_95pct <- function(hotel_no,p,d,q) { 
  
# create ARIMA prediction interval function
  fc_Arima_interval <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q) { 
  k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
  k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
  training_ts <- subset(full_dataset_ts,end=k)
  lambda <- BoxCox.lambda(in_sample_dataset_ts[,hotel_no])

  ## Arima model forecast
  fc_Arima<- Arima(training_ts[,hotel_no], lambda = lambda, order=c(p,d,q)) %>% forecast(h=k1)

  ## retrieve value of interest
  Arima_result  <- data.frame(full_dataset[(k+1):(k+k1),c(1,(hotel_no+1))],fc=fc_Arima[["mean"]],Arima_low95pc = fc_Arima[["lower"]][,2],Arima_up95pc = fc_Arima[["upper"]][,2])
 names(Arima_result)[1:2] =c("stay_date", "Final_arrival")
 result <- Arima_result  %>% mutate(Forecast = ifelse(Final_arrival >= Arima_low95pc & Final_arrival <= Arima_up95pc,1,0))
 return(result) 
}

# Get Arima model forecast interval result
## six-month forecasting errors
six_month_Arima <- fc_Arima_interval(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30", p,d,q) 

## three-month forecasting errors
three_month_1_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q)  

three_month_2_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q) 

three_month_3_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q) 

three_month_4_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q)   

## one-month forecasting errors
one_month_1_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q)  
one_month_2_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q)  
one_month_3_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q)  
one_month_4_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q)  
one_month_5_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q)  
one_month_6_Arima <-fc_Arima_interval(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q) 


# combine data as dataset
value<-c(mean(six_month_Arima$Forecast),mean(three_month_1_Arima$Forecast),mean(three_month_2_Arima$Forecast),mean(three_month_3_Arima$Forecast),mean(three_month_4_Arima$Forecast),mean(one_month_1_Arima$Forecast),mean(one_month_2_Arima $Forecast),mean(one_month_3_Arima$Forecast),mean(one_month_4_Arima$Forecast),mean(one_month_5_Arima $Forecast),mean(one_month_6_Arima $Forecast))

result <- data.frame(forecast_period= fc_timestamp,Arima_in_95pc = value)

return(result)
                
}

8.2.8 create Seasonal Arima 95% prediction comparison function

fc_SArima_95pct <- function(hotel_no,p,d,q,P,Q,D) { 
  
# create SARIMA prediction interval function
  fc_SArima_interval <- function(hotel_no,traintime1,traintime2,testtime1,testtime2,p,d,q,P,Q,D) { 
  k = abs(as.numeric(difftime(as.Date(traintime1), as.Date(traintime2), unit = "day"))) + 1
  k1= abs(as.numeric(difftime(as.Date(testtime1), as.Date(testtime2), unit = "day"))) + 1
  training_ts <- subset(full_dataset_ts,end=k)
  lambda <- BoxCox.lambda(training_ts[,hotel_no])

  ## Arima model forecast
  fc_SArima<- Arima(training_ts[,hotel_no], lambda=lambda,order=c(p,d,q),seasonal=c(P,Q,D),method ="CSS") %>% forecast(h=k1)

  ## retrieve value of interest
  SArima_result  <- data.frame(full_dataset[k+1:k1,c(1,hotel_no+1)],SArima_low95pc = fc_SArima[["lower"]][,2],SArima_up95pc =      fc_SArima[["upper"]][,2])
 names(SArima_result)[1:2] =c("stay_date", "Final_arrival")
 result <- SArima_result  %>% mutate(Forecast = ifelse(Final_arrival >= SArima_low95pc & Final_arrival <= SArima_up95pc,1,0))
 return(result) 
}

# Get Arima model forecast interval result
## six-month forecasting errors
six_month_SArima <- fc_SArima_interval(hotel_no, "2008-05-01","2009-10-31","2009-11-01","2010-04-30", p,d,q,P,Q,D) 

## three-month forecasting errors
three_month_1_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2010-01-31",p,d,q,P,Q,D)  

three_month_2_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2010-02-28",p,d,q,P,Q,D) 

three_month_3_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-03-31",p,d,q,P,Q,D) 

three_month_4_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-04-30",p,d,q,P,Q,D) 

## one-month forecasting errors
one_month_1_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-10-31","2009-11-01","2009-11-30",p,d,q,P,Q,D)  
one_month_2_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-11-30","2009-12-01","2009-12-31",p,d,q,P,Q,D)  
one_month_3_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2009-12-31","2010-01-01","2010-01-31",p,d,q,P,Q,D)  
one_month_4_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-01-31","2010-02-01","2010-02-28",p,d,q,P,Q,D)  
one_month_5_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-02-28","2010-03-01","2010-03-31",p,d,q,P,Q,D)  
one_month_6_SArima <-fc_SArima_interval(hotel_no,"2008-05-01","2010-03-31","2010-04-01","2010-04-30",p,d,q,P,Q,D) 


# combine data as dataset
value <- c(mean(six_month_SArima$Forecast),mean(three_month_1_SArima$Forecast),mean(three_month_2_SArima$Forecast),mean(three_month_3_SArima$Forecast),mean(three_month_4_SArima$Forecast),mean(one_month_1_SArima$Forecast),mean(one_month_2_SArima $Forecast),mean(one_month_3_SArima$Forecast),mean(one_month_4_SArima$Forecast),mean(one_month_5_SArima $Forecast),mean(one_month_6_SArima $Forecast))

result <- data.frame(forecast_period= fc_timestamp,SArima_in_95pc = value)

return(result)
                
}

8.2.9 create forecast result across model

fc_result_across2 <- function(hotel_no,p,d,q,p_S,d_S,q_S,P,D,Q) {
         k<-fc_result(hotel_no)
         A<-fc_Arima_error (hotel_no,p,d,q)
         SA<-fc_SArima_error (hotel_no,p_S,d_S,q_S,P,D,Q)
  MAE <-data.frame(forecast_period= k[["naive"]][,1],ses=k[["ses"]][,2],holt=k[["holt"]][,2],hw_add=k[["hw_add"]][,2],hw_mul=k[["hw_mul"]][,2],Arima=A[,2],Sarima=SA[,2])
  
  MAPE <-data.frame(forecast_period=k[["naive"]][,1],ses=k[["ses"]][,3],holt=k[["holt"]][,3],hw_add=k[["hw_add"]][,3],hw_mul=k[["hw_mul"]][,3],Arima=A[,3],Sarima=SA[,3])
  
  MASE <- data.frame(forecast_period=k[["naive"]][,1],ses=k[["ses"]][,4],holt=k[["holt"]][,4],hw_add=k[["hw_add"]][,4],hw_mul=k[["hw_mul"]][,4],Arima=A[,4],Sarima=SA[,4])
  
  return(list(MAE=MAE, MAPE=MAPE,MASE=MASE))
}

8.4.1 apply unit root test plot acf/pacf

# transform data with specific lambda
h01 <- in_sample_dataset_ts[,1]
autoplot(h01)

lambda <- BoxCox.lambda(h01)
lh01 <- BoxCox(h01,lambda)
autoplot(lh01)

# apply unit root test
lh01 %>% ur.kpss() %>% summary()

## 
## ####################### 
## # KPSS Unit Root Test # 
## ####################### 
## 
## Test is of type: mu with 6 lags. 
## 
## Value of test-statistic is: 0.4803 
## 
## Critical value for a significance level of: 
##                 10pct  5pct 2.5pct  1pct
## critical values 0.347 0.463  0.574 0.739

lh01 %>% ndiffs()

## [1] 1

lh01 %>% diff() %>% ur.kpss() %>% summary()

## 
## ####################### 
## # KPSS Unit Root Test # 
## ####################### 
## 
## Test is of type: mu with 6 lags. 
## 
## Value of test-statistic is: 0.0165 
## 
## Critical value for a significance level of: 
##                 10pct  5pct 2.5pct  1pct
## critical values 0.347 0.463  0.574 0.739

# acf pacf
# first diff
#lh01 %>% diff() %>% ggtsdisplay(main="Time Plot, ACF and PACF after first-order differencing")
# seasonal diff
#lh01 %>% diff(lag=7) %>%  ggtsdisplay(main="seasonal differences")
# first and second diff
#lh01 %>% diff() %>% diff() %>%  ggtsdisplay(main="second differences")
# seasonal diff and first diff
lh01 %>% diff(lag=7) %>% diff() %>%  ggtsdisplay(main="Time Plot, ACF and PACF after first-order differencing and seasonal differencing")

8.4.2 select parameters for Arima model and plot residuals

# Benchmark AICc=9510.82 ARIMA(2,1,1)(1,0,0)[7] 
GLWST_1 <- fc_Arima(1,7,1,2) #AICc=9509.8 
summary(GLWST_1)

## Series: in_sample_dataset_ts[, hotel_no] 
## ARIMA(7,1,2) 
## Box Cox transformation: lambda= 1.938722 
## 
## Coefficients:
##          ar1     ar2     ar3     ar4      ar5      ar6     ar7      ma1
##       0.0094  0.1545  0.1198  0.1105  -0.0777  -0.0675  0.4193  -0.5740
## s.e.  0.0694  0.0450  0.0392  0.0411   0.0396   0.0389  0.0389   0.0711
##           ma2
##       -0.4260
## s.e.   0.0706
## 
## sigma^2 estimated as 1954107:  log likelihood=-4744.7
## AIC=9509.39   AICc=9509.8   BIC=9552.45
## 
## Training set error measures:
##                     ME     RMSE      MAE       MPE     MAPE      MASE
## Training set -1.649613 19.53779 14.54559 -8.317612 18.88443 0.7603152
##                    ACF1
## Training set 0.08617374

checkresiduals(GLWST_1) 

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(7,1,2)
## Q* = 18.808, df = 5, p-value = 0.002087
## 
## Model df: 9.   Total lags used: 14

#GLWST_2 <- fc_Arima(1,1,1,1) #AICc=9609.19 
#summary(GLWST_2)

#GLWST_3 <- fc_Arima(1,0,1,2) #AICc=9602.75
#summary(GLWST_3)

GLWST_4 <- fc_Arima(1,7,1,21) #AICc=9456.41
summary(GLWST_4)

## Series: in_sample_dataset_ts[, hotel_no] 
## ARIMA(7,1,21) 
## Box Cox transformation: lambda= 1.938722 
## 
## Coefficients:
##           ar1      ar2      ar3      ar4      ar5      ar6     ar7     ma1
##       -0.5010  -0.4598  -0.4269  -0.4304  -0.4613  -0.4988  0.4824  0.0108
## s.e.   0.2241   0.2200   0.2093   0.2011   0.2030   0.2117  0.2204  0.2219
##           ma2     ma3     ma4     ma5     ma6      ma7     ma8      ma9
##       -0.0301  0.0151  0.0582  0.0010  0.0845  -0.7323  0.0414  -0.0198
## s.e.   0.1173  0.0655  0.0604  0.0634  0.0520   0.0559  0.1559   0.0858
##         ma10    ma11    ma12     ma13     ma14    ma15    ma16     ma17
##       0.0087  0.0081  0.0105  -0.0022  -0.1527  0.0577  0.0579  -0.0529
## s.e.  0.0676  0.0560  0.0571   0.0517   0.0578  0.0463  0.0481   0.0478
##          ma18    ma19    ma20    ma21
##       -0.0295  0.0902  0.0727  0.0750
## s.e.   0.0462  0.0507  0.0521  0.0532
## 
## sigma^2 estimated as 1683165:  log likelihood=-4697.35
## AIC=9452.71   AICc=9456.07   BIC=9577.59
## 
## Training set error measures:
##                     ME     RMSE      MAE       MPE     MAPE      MASE
## Training set -1.271447 17.80897 13.36571 -6.620254 16.97561 0.6986414
##                    ACF1
## Training set 0.07117836

checkresiduals(GLWST_4)

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(7,1,21)
## Q* = 13.866, df = 3, p-value = 0.003094
## 
## Model df: 28.   Total lags used: 31

#GLWST_5 <- fc_Arima(1,3,2,1) #AICc=9646.07
#summary(GLWST_5)

#GLWST_6 <- fc_Arima(1,0,2,6) #AICc=9598.98
#summary(GLWST_6)

#GLWST_7 <- fc_Arima(1,6,2,21) #AICc=9458.78
#summary(GLWST_7)

8.4.3 Arima Forecast

fc_Arima_error(1,7,1,21)

##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 13.41115 0.1704320               NaN
## 2   6m_Nov-Apr_out 28.22944 0.4849144  1.44174038323037
## 3    3m_Nov-Jan_in 13.41115 0.1704320               NaN
## 4   3m_Nov-Jan_out 32.90497 0.6434708  1.81056079420739
## 5    3m_Dec-Feb_in 13.29621 0.1686590               NaN
## 6   3m_Dec-Feb_out 29.66175 0.5812397  1.75282814004412
## 7    3m_Jan-Mar_in 13.57357 0.1809530               NaN
## 8   3m_Jan-Mar_out 20.97142 0.3045034  1.06634342353206
## 9    3m_Feb-Apr_in 13.74895 0.1810162               NaN
## 10  3m_Feb-Apr_out 21.97257 0.2175787  1.04463604086379
## 11       1m_Nov_in 13.41115 0.1704320               NaN
## 12      1m_Nov_out 13.66751 0.1586879 0.788510184726342
## 13       1m_Dec_in 13.29621 0.1686590               NaN
## 14      1m_Dec_out 29.85335 0.6612236  1.39375567094102
## 15       1m_Jan_in 13.57357 0.1809530               NaN
## 16      1m_Jan_out 23.11867 0.4809133  1.46860412244383
## 17       1m_Feb_in 13.74895 0.1810162               NaN
## 18      1m_Feb_out 16.79160 0.1681519 0.691419027631672
## 19       1m_Mar_in 13.50858 0.1770913               NaN
## 20      1m_Mar_out 19.07826 0.2350631 0.708294520670725
## 21       1m_Apr_in 13.86888 0.1875040               NaN
## 22      1m_Apr_out 18.83245 0.2348352 0.848308642611688

fc_Arima_error(1,7,1,2)

##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 14.52801 0.1850786               NaN
## 2   6m_Nov-Apr_out 29.57394 0.5061296  1.51040716122949
## 3    3m_Nov-Jan_in 14.52801 0.1850786               NaN
## 4   3m_Nov-Jan_out 34.71262 0.6701543  1.91002470655003
## 5    3m_Dec-Feb_in 14.50098 0.1838467               NaN
## 6   3m_Dec-Feb_out 33.11938 0.6451855  1.95715290376984
## 7    3m_Jan-Mar_in 14.94337 0.1987186               NaN
## 8   3m_Jan-Mar_out 23.72852 0.3509090  1.20653480890996
## 9    3m_Feb-Apr_in 15.01093 0.1988081               NaN
## 10  3m_Feb-Apr_out 23.47816 0.2369889  1.11621591854316
## 11       1m_Nov_in 14.52801 0.1850786               NaN
## 12      1m_Nov_out 17.19369 0.1990354 0.991943628166903
## 13       1m_Dec_in 14.50098 0.1838467               NaN
## 14      1m_Dec_out 31.61924 0.7040996  1.47619952475317
## 15       1m_Jan_in 14.94337 0.1987186               NaN
## 16      1m_Jan_out 27.41032 0.5551548  1.74122909332112
## 17       1m_Feb_in 15.01093 0.1988081               NaN
## 18      1m_Feb_out 18.84691 0.1937591 0.776049052871373
## 19       1m_Mar_in 14.99985 0.1974268               NaN
## 20      1m_Mar_out 22.20607 0.2550257 0.824417090624261
## 21       1m_Apr_in 15.14658 0.2028084               NaN
## 22      1m_Apr_out 18.21139 0.2365036 0.820333077007016

8.4.4 Arima Prediction interval accuracy

fc_Arima_95pct(1,7,1,2)

##    forecast_period Arima_in_95pc
## 1    6m_Nov-Apr_in     0.9116022
## 2   6m_Nov-Apr_out     0.8478261
## 3    3m_Nov-Jan_in     0.8333333
## 4   3m_Nov-Jan_out     0.9888889
## 5    3m_Dec-Feb_in     1.0000000
## 6   3m_Dec-Feb_out     1.0000000
## 7    3m_Jan-Mar_in     0.8709677
## 8   3m_Jan-Mar_out     0.9677419
## 9    3m_Feb-Apr_in     1.0000000
## 10  3m_Feb-Apr_out     0.9677419
## 11       1m_Nov_in     1.0000000
## 12      1m_Nov_out     0.9116022
## 13       1m_Dec_in     0.8478261
## 14      1m_Dec_out     0.8333333
## 15       1m_Jan_in     0.9888889
## 16      1m_Jan_out     1.0000000
## 17       1m_Feb_in     1.0000000
## 18      1m_Feb_out     0.8709677
## 19       1m_Mar_in     0.9677419
## 20      1m_Mar_out     1.0000000
## 21       1m_Apr_in     0.9677419
## 22      1m_Apr_out     1.0000000

8.4.5 select parameters for SArima model and plot residuals

# Benchmark AICc=9510.82 ARIMA(2,1,1)(1,0,0)[7] 
#GLWST_S1 <- fc_SArima(1,1,0,1,1,1,3)  #AICc=9338.35 
#summary(GLWST_S1)

#GLWST_S2 <- fc_SArima(1,1,0,2,2,1,1)  #AICc=9335.38 
#summary(GLWST_S2)

#GLWST_S3 <- fc_SArima(1,3,1,1,2,1,3)  #AICc=9324.79
#summary(GLWST_S3)

#GLWST_S4 <- fc_SArima(1,3,1,2,2,1,1)  #AICc=9324.87
#summary(GLWST_S4)

GLWST_S5 <- fc_SArima(1,3,1,1,3,1,1)  #AICc=9315.48
summary(GLWST_S5)

## Series: in_sample_dataset_ts[, hotel_no] 
## ARIMA(3,1,1)(3,1,1)[7] 
## Box Cox transformation: lambda= 1.938722 
## 
## Coefficients:
##          ar1      ar2     ar3      ma1    sar1     sar2    sar3     sma1
##       0.4608  -0.0120  0.0371  -0.9555  0.1730  -0.0290  0.1372  -1.0000
## s.e.  0.0475   0.0494  0.0463   0.0207  0.0462   0.0451  0.0450   0.0277
## 
## sigma^2 estimated as 1633525:  log likelihood=-4648.57
## AIC=9315.14   AICc=9315.48   BIC=9353.78
## 
## Training set error measures:
##                     ME    RMSE      MAE       MPE    MAPE      MASE
## Training set -1.332685 17.8589 13.16233 -6.569699 16.7904 0.6880105
##                    ACF1
## Training set 0.07267091

checkresiduals(GLWST_S5) 

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(3,1,1)(3,1,1)[7]
## Q* = 6.5598, df = 6, p-value = 0.3635
## 
## Model df: 8.   Total lags used: 14

#GLWST_S6 <- fc_SArima(1,7,0,0,0,1,2)  #AICc=9338.51
#summary(GLWST_S6)

8.4.6 SArima Forecast

fc_SArima_error(1,3,1,1,3,1,1)

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 12.78628 0.1518631               NaN
## 2   6m_Nov-Apr_out 27.44858 0.4670655  1.40186015810188
## 3    3m_Nov-Jan_in 12.78628 0.1518631               NaN
## 4   3m_Nov-Jan_out 31.62772 0.6187564   1.7402813646935
## 5    3m_Dec-Feb_in 12.70031 0.1491647               NaN
## 6   3m_Dec-Feb_out 30.86518 0.6084707  1.82394341546168
## 7    3m_Jan-Mar_in 13.21222 0.1594099               NaN
## 8   3m_Jan-Mar_out 21.85138 0.3231854  1.16093541521193
## 9    3m_Feb-Apr_in 13.44758 0.1642157               NaN
## 10  3m_Feb-Apr_out 40.46131 0.3985930  1.92364140046507
## 11       1m_Nov_in 12.78628 0.1518631               NaN
## 12      1m_Nov_out 12.90527 0.1439459 0.744534984540394
## 13       1m_Dec_in 12.70031 0.1491647               NaN
## 14      1m_Dec_out 29.74818 0.6860186  1.38884559083622
## 15       1m_Jan_in 13.21222 0.1594099               NaN
## 16      1m_Jan_out 26.51960 0.5487885  1.68464703480619
## 17       1m_Feb_in 13.44758 0.1642157               NaN
## 18      1m_Feb_out 27.91918 0.2873494  1.14961313559584
## 19       1m_Mar_in 13.38701 0.1622929               NaN
## 20      1m_Mar_out 20.69215 0.2202115 0.768211656516521
## 21       1m_Apr_in 13.41851 0.1640141               NaN
## 22      1m_Apr_out 19.75689 0.2399248 0.889950128449772

8.4.7 SArima Prediction interval accuracy

fc_SArima_95pct(1,3,1,1,3,1,1)

##    forecast_period SArima_in_95pc
## 1    6m_Nov-Apr_in      0.9944751
## 2   6m_Nov-Apr_out      0.9891304
## 3    3m_Nov-Jan_in      0.9666667
## 4   3m_Nov-Jan_out      0.9555556
## 5    3m_Dec-Feb_in      0.8314607
## 6   3m_Dec-Feb_out      1.0000000
## 7    3m_Jan-Mar_in      0.9354839
## 8   3m_Jan-Mar_out      0.9032258
## 9    3m_Feb-Apr_in      0.8928571
## 10  3m_Feb-Apr_out      0.9677419
## 11       1m_Nov_in      1.0000000
## 12      1m_Nov_out      0.9944751
## 13       1m_Dec_in      0.9891304
## 14      1m_Dec_out      0.9666667
## 15       1m_Jan_in      0.9555556
## 16      1m_Jan_out      0.8314607
## 17       1m_Feb_in      1.0000000
## 18      1m_Feb_out      0.9354839
## 19       1m_Mar_in      0.9032258
## 20      1m_Mar_out      0.8928571
## 21       1m_Apr_in      0.9677419
## 22      1m_Apr_out      1.0000000

GLWST_95interval <-cbind(fc_Arima_95pct(1,7,1,2),fc_SArima_95pct(1,3,1,1,3,1,1)[2])
GLWST_95interval <- txtRound(GLWST_95interval[-1],2)
GLWST_95interval <- data.frame(forecast_period = fc_timestamp, GLWST_95interval)
htmlTable(GLWST_95interval)

Observations

• the 95percent prediction are not very robust and stable, with many moths forecast fall out the 95pct interval, 6month forecast for Nov2009, 3month forecast for Feb2009 and 1month forecast for Feb2009 perform the worst.

8.4.8 Comparison by MAE, MAPE and MASE across 6 models

fc_result_across2(1,7,1,2,3,1,1,3,1,1)

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul    Arima   Sarima
## 1    6m_Nov-Apr_in 17.16472 17.13131 14.23579 14.68280 14.52801 12.78628
## 2   6m_Nov-Apr_out 29.56734 30.70201 24.39895 24.82579 29.57394 27.44858
## 3    3m_Nov-Jan_in 17.16472 17.13131 14.23579 14.68280 14.52801 12.78628
## 4   3m_Nov-Jan_out 34.69838 35.46322 28.91156 29.40811 34.71262 31.62772
## 5    3m_Dec-Feb_in 17.14492 17.12651 14.03028 14.54415 14.50098 12.70031
## 6   3m_Dec-Feb_out 31.32584 31.26093 31.17146 30.20617 33.11938 30.86518
## 7    3m_Jan-Mar_in 17.62643 17.63378 14.47323 14.83175 14.94337 13.21222
## 8   3m_Jan-Mar_out 23.17962 23.73684 24.72472 21.86841 23.72852 21.85138
## 9    3m_Feb-Apr_in 17.48667 17.49045 14.55219 14.79067 15.01093 13.44758
## 10  3m_Feb-Apr_out 23.26497 24.07563 20.84123 18.11542 23.47816 40.46131
## 11       1m_Nov_in 17.16472 17.13131 14.23579 14.68280 14.52801 12.78628
## 12      1m_Nov_out 17.12180 17.26091 11.89435 12.17564 17.19369 12.90527
## 13       1m_Dec_in 17.14492 17.12651 14.03028 14.54415 14.50098 12.70031
## 14      1m_Dec_out 31.91392 31.88626 30.40857 30.03456 31.61924 29.74818
## 15       1m_Jan_in 17.62643 17.63378 14.47323 14.83175 14.94337 13.21222
## 16      1m_Jan_out 23.07441 22.93960 36.65615 33.55495 27.41032 26.51960
## 17       1m_Feb_in 17.98274 17.49045 14.55219 14.80548 15.01093 13.44758
## 18      1m_Feb_out 22.95372 20.46945 17.53358 19.02115 18.84691 27.91918
## 19       1m_Mar_in 17.55837 17.55315 14.58160 14.82875 14.99985 13.38701
## 20      1m_Mar_out 23.50660 23.66548 18.45737 20.02641 22.20607 20.69215
## 21       1m_Apr_in 17.73291 17.71103 14.59907 14.93417 15.14658 13.41851
## 22      1m_Apr_out 20.98610 21.30267 24.28184 24.55066 18.21139 19.75689
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul     Arima
## 1    6m_Nov-Apr_in 0.2108561 0.2106789 0.1677099 0.1725621 0.1850786
## 2   6m_Nov-Apr_out 0.5061138 0.5241845 0.4202772 0.4277763 0.5061296
## 3    3m_Nov-Jan_in 0.2108561 0.2106789 0.1677099 0.1725621 0.1850786
## 4   3m_Nov-Jan_out 0.6701037 0.6845672 0.5722553 0.5808797 0.6701543
## 5    3m_Dec-Feb_in 0.2095655 0.2093029 0.1644125 0.1705139 0.1838467
## 6   3m_Dec-Feb_out 0.5987116 0.5973831 0.6116655 0.5924527 0.6451855
## 7    3m_Jan-Mar_in 0.2221101 0.2216822 0.1735547 0.1770651 0.1987186
## 8   3m_Jan-Mar_out 0.3181623 0.3190124 0.4175608 0.3419958 0.3509090
## 9    3m_Feb-Apr_in 0.2230310 0.2225737 0.1787784 0.1791103 0.1988081
## 10  3m_Feb-Apr_out 0.2405159 0.2452765 0.2081257 0.2121346 0.2369889
## 11       1m_Nov_in 0.2108561 0.2106789 0.1677099 0.1725621 0.1850786
## 12      1m_Nov_out 0.1985084 0.2005270 0.1286130 0.1328571 0.1990354
## 13       1m_Dec_in 0.2095655 0.2093029 0.1644125 0.1705139 0.1838467
## 14      1m_Dec_out 0.6757493 0.6750160 0.6878321 0.6715978 0.7040996
## 15       1m_Jan_in 0.2221101 0.2216822 0.1735547 0.1770651 0.1987186
## 16      1m_Jan_out 0.4614499 0.4567448 0.7486518 0.6932201 0.5551548
## 17       1m_Feb_in 0.2336794 0.2225737 0.1787784 0.1797262 0.1988081
## 18      1m_Feb_out 0.3156966 0.2174224 0.1833935 0.1945147 0.1937591
## 19       1m_Mar_in 0.2231886 0.2227842 0.1785943 0.1794635 0.1974268
## 20      1m_Mar_out 0.2679289 0.2683444 0.2129133 0.2262414 0.2550257
## 21       1m_Apr_in 0.2250199 0.2248767 0.1787301 0.1813381 0.2028084
## 22      1m_Apr_out 0.2778388 0.2819059 0.3053951 0.3060608 0.2365036
##       Sarima
## 1  0.1518631
## 2  0.4670655
## 3  0.1518631
## 4  0.6187564
## 5  0.1491647
## 6  0.6084707
## 7  0.1594099
## 8  0.3231854
## 9  0.1642157
## 10 0.3985930
## 11 0.1518631
## 12 0.1439459
## 13 0.1491647
## 14 0.6860186
## 15 0.1594099
## 16 0.5487885
## 17 0.1642157
## 18 0.2873494
## 19 0.1622929
## 20 0.2202115
## 21 0.1640141
## 22 0.2399248
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out  1.51007031723736  1.56802032878809  1.24610869159936
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  1.90924101308585  1.95132532723337  1.59082739119975
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  1.85116595265857   1.8473298401296  1.84204320025238
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  1.23150299808857  1.26110703952513  1.31359172056293
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out  1.10608052462494  1.14462111892475 0.990849252153732
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out 0.987796146118206 0.995821556838069 0.686212323034542
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out   1.4899569826427  1.48866583852698  1.41967708388251
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  1.46579268309207  1.45722866851363  2.32856705580899
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.945153313792086 0.842859605534413 0.721970880917249
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out 0.872700225739768 0.878598827909082 0.685243730902185
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out 0.945319629121382 0.959579656671636  1.09377652193263
##               hw_mul             Arima            Sarima
## 1                NaN               NaN               NaN
## 2    1.2679087638248  1.51040716122949  1.40186015810188
## 3                NaN               NaN               NaN
## 4   1.61814948410176  1.91002470655003   1.7402813646935
## 5                NaN               NaN               NaN
## 6   1.78500014535895  1.95715290376984  1.82394341546168
## 7                NaN               NaN               NaN
## 8   1.16183997927205  1.20653480890996  1.16093541521193
## 9                NaN               NaN               NaN
## 10  0.86125672682618  1.11621591854316  1.92364140046507
## 11               NaN               NaN               NaN
## 12 0.702440627424316 0.991943628166903 0.744534984540394
## 13               NaN               NaN               NaN
## 14  1.40221584981471  1.47619952475317  1.38884559083622
## 15               NaN               NaN               NaN
## 16  2.13156450930606  1.74122909332112  1.68464703480619
## 17               NaN               NaN               NaN
## 18 0.783223727928355 0.776049052871373  1.14961313559584
## 19               NaN               NaN               NaN
## 20 0.743495441486405 0.824417090624261 0.768211656516521
## 21               NaN               NaN               NaN
## 22  1.10588551357609 0.820333077007016 0.889950128449772

8.4.9 comparison by MASE between ARIMA and SARIMA

fc_result_arimasarima(1,7,1,2,3,1,1,3,1,1)

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## $MASE
##    forecast_period             Arima            Sarima
## 1    6m_Nov-Apr_in               NaN               NaN
## 2   6m_Nov-Apr_out  1.51040716122949  1.40186015810188
## 3    3m_Nov-Jan_in               NaN               NaN
## 4   3m_Nov-Jan_out  1.91002470655003   1.7402813646935
## 5    3m_Dec-Feb_in               NaN               NaN
## 6   3m_Dec-Feb_out  1.95715290376984  1.82394341546168
## 7    3m_Jan-Mar_in               NaN               NaN
## 8   3m_Jan-Mar_out  1.20653480890996  1.16093541521193
## 9    3m_Feb-Apr_in               NaN               NaN
## 10  3m_Feb-Apr_out  1.11621591854316  1.92364140046507
## 11       1m_Nov_in               NaN               NaN
## 12      1m_Nov_out 0.991943628166903 0.744534984540394
## 13       1m_Dec_in               NaN               NaN
## 14      1m_Dec_out  1.47619952475317  1.38884559083622
## 15       1m_Jan_in               NaN               NaN
## 16      1m_Jan_out  1.74122909332112  1.68464703480619
## 17       1m_Feb_in               NaN               NaN
## 18      1m_Feb_out 0.776049052871373  1.14961313559584
## 19       1m_Mar_in               NaN               NaN
## 20      1m_Mar_out 0.824417090624261 0.768211656516521
## 21       1m_Apr_in               NaN               NaN
## 22      1m_Apr_out 0.820333077007016 0.889950128449772

GLWST_arimaerror <-data.frame(fc_result_arimasarima(1,7,1,2,3,1,1,3,1,1)) %>% filter(row_number()%%2 ==0)

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

## Warning in predict.Arima(object, n.ahead = h): MA part of model is not
## invertible

GLWST_arimaerror<-txtRound(GLWST_arimaerror[,-1],2)
GLWST_arimaerror <- data.frame(forecast_period=fc_timestamp_out,GLWST_arimaerror) 
htmlTable(GLWST_arimaerror)

Observations

• the forecast accuracy of Arima and Sarima model for GLWST hotel dosen’t outperform ets model in most of the months forcast except the 1month for Feb2009, however, it still forecast worst than naive model for that month.

8.5.1 apply unit root test plot acf/pacf

# transform data with specific lambda
h02 <- in_sample_dataset_ts[,2]
autoplot(h02)

lambda <- BoxCox.lambda(h02)
lh02 <- BoxCox(h02,lambda)
autoplot(lh02)

# apply unit root test
lh02 %>% ur.kpss() %>% summary()

## 
## ####################### 
## # KPSS Unit Root Test # 
## ####################### 
## 
## Test is of type: mu with 6 lags. 
## 
## Value of test-statistic is: 1.1955 
## 
## Critical value for a significance level of: 
##                 10pct  5pct 2.5pct  1pct
## critical values 0.347 0.463  0.574 0.739

lh02 %>% ndiffs()

## [1] 1

lh02 %>% nsdiffs()

## [1] 1

# acf pacf
lh02 %>% diff() %>% ur.kpss() %>% summary()

## 
## ####################### 
## # KPSS Unit Root Test # 
## ####################### 
## 
## Test is of type: mu with 6 lags. 
## 
## Value of test-statistic is: 0.0461 
## 
## Critical value for a significance level of: 
##                 10pct  5pct 2.5pct  1pct
## critical values 0.347 0.463  0.574 0.739

# no difference
lh02 %>% ggtsdisplay(main="Time Plot, ACF and PACF with no differencing")

# first 
lh02 %>% diff() %>% ggtsdisplay(main="first difference") 

# seasonal
lh02 %>% diff(lag=7) %>% ggtsdisplay(main="Time Plot, ACF and PACF after seasonal differencing")

# first and second
lh02 %>% diff() %>% diff() %>%  ggtsdisplay(main="second difference")

# seasonal and first diff
lh02 %>% diff(lag=7) %>% diff() %>%  ggtsdisplay(main="seasonal and first difference")

8.5.2 select parameters for Arima model and plot residuals

# Benchmark AICc=1240.48
#MLKEP_1 <- fc_Arima(2,1,0,2) #  AICc=1768.3
#summary(MLKEP_1)

#MLKEP_2 <- fc_Arima(2,3,2,1)  # AICc=1916.25 
#summary(MLKEP_2)

#MLKEP_3 <- fc_Arima(2,1,1,1) # AICc=1798.65 
#summary(MLKEP_3)

MLKEP_4 <- fc_Arima(2,1,0,21) # AICc=1486.97 
summary(MLKEP_4)

## Series: in_sample_dataset_ts[, hotel_no] 
## ARIMA(1,0,21) with non-zero mean 
## Box Cox transformation: lambda= 0.1879901 
## 
## Coefficients:
##          ar1     ma1     ma2      ma3     ma4     ma5     ma6     ma7
##       0.1707  0.2315  0.1785  -0.0439  0.0403  0.0443  0.0158  0.5736
## s.e.  0.2186  0.2160  0.0881   0.0661  0.0465  0.0466  0.0534  0.0519
##          ma8     ma9     ma10     ma11    ma12    ma13    ma14    ma15
##       0.1571  0.1850  -0.0499  -0.0564  0.0494  0.0204  0.3633  0.1022
## s.e.  0.1179  0.0674   0.0763   0.0528  0.0597  0.0718  0.0491  0.0618
##         ma16     ma17     ma18    ma19     ma20    ma21    mean
##       0.1061  -0.0259  -0.0160  0.0039  -0.0638  0.2582  6.8184
## s.e.  0.0571   0.0599   0.0482  0.0497   0.0687  0.0461  0.1395
## 
## sigma^2 estimated as 0.83:  log likelihood=-718.34
## AIC=1484.68   AICc=1486.97   BIC=1588.07
## 
## Training set error measures:
##                    ME     RMSE      MAE       MPE     MAPE      MASE
## Training set 6.206727 31.29194 24.69189 -11.49305 35.88869 0.9194148
##                   ACF1
## Training set 0.1114995

checkresiduals(MLKEP_4)

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(1,0,21) with non-zero mean
## Q* = 48.284, df = 3, p-value = 1.853e-10
## 
## Model df: 23.   Total lags used: 26

8.5.3 select parameters for SArima model and plot residuals

# Benchmark AICc=1240.48
#MLKEP_S1 <- fc_SArima(2,2,1,1,1,1,2) # 1239.37
#summary(MLKEP_S1)


#MLKEP_S2 <- fc_SArima(2,3,1,1,1,1,2)) # 1239.37
#summary(MLKEP_S2)

#MLKEP_S3 <- fc_SArima(2,1,1,1,1,1,2)) # 1238.11
#summary(MLKEP_S3)

#MLKEP_S4 <- fc_SArima(2,6,1,0,7,0,0)) # 1238.11
#summary(MLKEP_S3)

MLKEP_S4 <- fc_SArima(2,7,0,0,0,1,2) # 1230.5
summary(MLKEP_S4)

## Series: in_sample_dataset_ts[, hotel_no] 
## ARIMA(7,0,0)(0,1,2)[7] 
## Box Cox transformation: lambda= 0.1879901 
## 
## Coefficients:
##          ar1     ar2      ar3     ar4      ar5     ar6     ar7     sma1
##       0.4782  0.0823  -0.0949  0.1750  -0.0031  0.0098  0.1427  -0.9184
## s.e.  0.0430  0.0474   0.0477  0.0486   0.0485  0.0481  0.0685   0.0883
##          sma2
##       -0.0326
## s.e.   0.0839
## 
## sigma^2 estimated as 0.5405:  log likelihood=-605.04
## AIC=1230.09   AICc=1230.5   BIC=1273.04
## 
## Training set error measures:
##                    ME     RMSE     MAE       MPE     MAPE      MASE
## Training set 4.143843 25.69952 18.9932 -5.166946 26.53972 0.7072214
##                    ACF1
## Training set 0.08568077

checkresiduals(MLKEP_S4) 

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(7,0,0)(0,1,2)[7]
## Q* = 10.062, df = 5, p-value = 0.0735
## 
## Model df: 9.   Total lags used: 14

8.5.4 Arima Forecast

fc_Arima_error(2,1,0,21)

##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 24.66547 0.3584096               NaN
## 2   6m_Nov-Apr_out 44.91730 0.6371228  2.39118581025824
## 3    3m_Nov-Jan_in 24.66547 0.3584096               NaN
## 4   3m_Nov-Jan_out 47.67571 0.7648333  2.48648833358686
## 5    3m_Dec-Feb_in 24.60048 0.3593358               NaN
## 6   3m_Dec-Feb_out 40.87112 0.7687634  2.40575563848602
## 7    3m_Jan-Mar_in 24.86703 0.3555949               NaN
## 8   3m_Jan-Mar_out 44.87847 0.6292966  2.50135465975378
## 9    3m_Feb-Apr_in 24.79729 0.3588897               NaN
## 10  3m_Feb-Apr_out 40.47731 0.4655955  2.20200506717963
## 11       1m_Nov_in 24.66547 0.3584096               NaN
## 12      1m_Nov_out 49.04758 0.4447614  2.37327010250779
## 13       1m_Dec_in 24.60048 0.3593358               NaN
## 14      1m_Dec_out 36.91538 0.6891902  1.82516251706604
## 15       1m_Jan_in 24.86703 0.3555949               NaN
## 16      1m_Jan_out 49.19573 0.8868399   2.9498407151449
## 17       1m_Feb_in 24.79729 0.3588897               NaN
## 18      1m_Feb_out 32.10311 0.3699352 0.518987849397563
## 19       1m_Mar_in 24.48886 0.3530501               NaN
## 20      1m_Mar_out 37.41415 0.3851852  2.18425383977721
## 21       1m_Apr_in 24.19597 0.3563215               NaN
## 22      1m_Apr_out 39.06601 0.4879097   1.6277505250801

8.5.5 Arima Prediction interval accuracy

fc_Arima_95pct(2,1,0,21)

##    forecast_period Arima_in_95pc
## 1    6m_Nov-Apr_in     0.9723757
## 2   6m_Nov-Apr_out     0.9456522
## 3    3m_Nov-Jan_in     0.9333333
## 4   3m_Nov-Jan_out     0.9555556
## 5    3m_Dec-Feb_in     1.0000000
## 6   3m_Dec-Feb_out     1.0000000
## 7    3m_Jan-Mar_in     0.9354839
## 8   3m_Jan-Mar_out     0.8709677
## 9    3m_Feb-Apr_in     1.0000000
## 10  3m_Feb-Apr_out     1.0000000
## 11       1m_Nov_in     0.9666667
## 12      1m_Nov_out     0.9723757
## 13       1m_Dec_in     0.9456522
## 14      1m_Dec_out     0.9333333
## 15       1m_Jan_in     0.9555556
## 16      1m_Jan_out     1.0000000
## 17       1m_Feb_in     1.0000000
## 18      1m_Feb_out     0.9354839
## 19       1m_Mar_in     0.8709677
## 20      1m_Mar_out     1.0000000
## 21       1m_Apr_in     1.0000000
## 22      1m_Apr_out     0.9666667

8.5.6 Seasonal Arima Forecast

fc_SArima_error(2,7,0,0,0,1,2)

##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 18.46402 0.2725827               NaN
## 2   6m_Nov-Apr_out 26.39705 0.4186814  1.40525460249044
## 3    3m_Nov-Jan_in 18.46402 0.2725827               NaN
## 4   3m_Nov-Jan_out 32.78799 0.6012078  1.71003120065922
## 5    3m_Dec-Feb_in 18.43547 0.2655255               NaN
## 6   3m_Dec-Feb_out 27.55973 0.6327700  1.62222069380101
## 7    3m_Jan-Mar_in 18.66958 0.2708815               NaN
## 8   3m_Jan-Mar_out 22.83732 0.2926796   1.4343049976313
## 9    3m_Feb-Apr_in 18.65998 0.2754222               NaN
## 10  3m_Feb-Apr_out 18.75691 0.2054855  1.02039410524754
## 11       1m_Nov_in 18.46402 0.2725827               NaN
## 12      1m_Nov_out 30.02807 0.2533241  1.45297091409669
## 13       1m_Dec_in 18.43547 0.2655255               NaN
## 14      1m_Dec_out 35.66195 0.8870637  1.76319041440316
## 15       1m_Jan_in 18.66958 0.2708815               NaN
## 16      1m_Jan_out 27.72846 0.4678975   1.6626348866122
## 17       1m_Feb_in 18.65998 0.2754222               NaN
## 18      1m_Feb_out 12.85905 0.1468516 0.207882977134548
## 19       1m_Mar_in 18.33819 0.2693435               NaN
## 20      1m_Mar_out 18.23914 0.1734935  1.06480848108438
## 21       1m_Apr_in 18.27448 0.2721646               NaN
## 22      1m_Apr_out 18.97741 0.2418188 0.790725306183894

8.5.7 SArima Prediction interval accuracy

fc_SArima_95pct(2,7,0,0,0,1,2)

##    forecast_period SArima_in_95pc
## 1    6m_Nov-Apr_in      0.9558011
## 2   6m_Nov-Apr_out      0.9130435
## 3    3m_Nov-Jan_in      0.8888889
## 4   3m_Nov-Jan_out      0.9777778
## 5    3m_Dec-Feb_in      0.9887640
## 6   3m_Dec-Feb_out      1.0000000
## 7    3m_Jan-Mar_in      0.8064516
## 8   3m_Jan-Mar_out      0.9354839
## 9    3m_Feb-Apr_in      1.0000000
## 10  3m_Feb-Apr_out      0.9677419
## 11       1m_Nov_in      0.9666667
## 12      1m_Nov_out      0.9558011
## 13       1m_Dec_in      0.9130435
## 14      1m_Dec_out      0.8888889
## 15       1m_Jan_in      0.9777778
## 16      1m_Jan_out      0.9887640
## 17       1m_Feb_in      1.0000000
## 18      1m_Feb_out      0.8064516
## 19       1m_Mar_in      0.9354839
## 20      1m_Mar_out      1.0000000
## 21       1m_Apr_in      0.9677419
## 22      1m_Apr_out      0.9666667

MLKEP_95interval <- cbind(fc_Arima_95pct(2,1,0,21),fc_SArima_95pct(2,7,0,0,0,1,2)[2])
MLKEP_95interval <- txtRound(MLKEP_95interval[-1],2)
MLKEP_95interval <- data.frame(forecast_period = fc_timestamp,MLKEP_95interval)
htmlTable(MLKEP_95interval)

8.5.8 Comparison by MAE, MAPE and MASE across 6 models

fc_result_across2(2,1,0,21,7,0,0,0,1,2)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul    Arima   Sarima
## 1    6m_Nov-Apr_in 38.77455 38.77184 21.18071 20.90222 24.66547 18.46402
## 2   6m_Nov-Apr_out 45.49341 45.18002 40.44032 46.23437 44.91730 26.39705
## 3    3m_Nov-Jan_in 38.77455 38.77184 21.18071 20.90222 24.66547 18.46402
## 4   3m_Nov-Jan_out 47.99566 48.14022 43.31319 46.65270 47.67571 32.78799
## 5    3m_Dec-Feb_in 39.16804 39.15002 21.04567 20.98880 24.60048 18.43547
## 6   3m_Dec-Feb_out 50.00241 51.81970 33.81385 31.80701 40.87112 27.55973
## 7    3m_Jan-Mar_in 39.39255 39.39627 21.49253 21.03735 24.86703 18.66958
## 8   3m_Jan-Mar_out 50.20995 50.49698 72.18988 60.41168 44.87847 22.83732
## 9    3m_Feb-Apr_in 39.80263 39.80379 21.73913 20.74706 24.79729 18.65998
## 10  3m_Feb-Apr_out 41.25520 40.99548 19.07638 29.57399 40.47731 18.75691
## 11       1m_Nov_in 38.77455 38.77184 21.18071 20.90222 24.66547 18.46402
## 12      1m_Nov_out 51.26677 51.00898 49.68810 55.99825 49.04758 30.02807
## 13       1m_Dec_in 39.16804 39.15002 21.04567 20.98880 24.60048 18.43547
## 14      1m_Dec_out 53.11451 54.45684 41.05527 38.70986 36.91538 35.66195
## 15       1m_Jan_in 39.39255 39.39627 21.49253 21.03735 24.86703 18.66958
## 16      1m_Jan_out 47.38678 47.48135 63.69622 51.55298 49.19573 27.72846
## 17       1m_Feb_in 37.75368 39.80379 21.73913 20.82137 24.79729 18.65998
## 18      1m_Feb_out 41.83729 38.40744 13.61814 19.70531 32.10311 12.85905
## 19       1m_Mar_in 39.82918 39.83565 21.39390 20.43778 24.48886 18.33819
## 20      1m_Mar_out 43.19087 42.83800 19.74626 23.01562 37.41415 18.23914
## 21       1m_Apr_in 40.01951 40.02174 21.21729 20.25453 24.19597 18.27448
## 22      1m_Apr_out 41.47564 41.52681 28.07609 26.44477 39.06601 18.97741
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul     Arima
## 1    6m_Nov-Apr_in 0.6473017 0.6530131 0.3412081 0.3028179 0.3584096
## 2   6m_Nov-Apr_out 0.6153640 0.6353902 0.5024606 0.4668452 0.6371228
## 3    3m_Nov-Jan_in 0.6473017 0.6530131 0.3412081 0.3028179 0.3584096
## 4   3m_Nov-Jan_out 0.7401124 0.7608638 0.5902200 0.5149623 0.7648333
## 5    3m_Dec-Feb_in 0.6428962 0.6521671 0.3352257 0.2980816 0.3593358
## 6   3m_Dec-Feb_out 1.1311959 1.2004435 0.8216322 0.7622298 0.7687634
## 7    3m_Jan-Mar_in 0.6515307 0.6538105 0.3512270 0.3050282 0.3555949
## 8   3m_Jan-Mar_out 0.5595839 0.5582343 0.9358860 0.5931100 0.6292966
## 9    3m_Feb-Apr_in 0.6625364 0.6674092 0.3611149 0.3094236 0.3588897
## 10  3m_Feb-Apr_out 0.5546310 0.5695227 0.2145234 0.2689125 0.4655955
## 11       1m_Nov_in 0.6473017 0.6530131 0.3412081 0.3028179 0.3584096
## 12      1m_Nov_out 0.4941932 0.4954742 0.4818548 0.4579445 0.4447614
## 13       1m_Dec_in 0.6428962 0.6521671 0.3352257 0.2980816 0.3593358
## 14      1m_Dec_out 1.1402568 1.1848696 1.0512742 0.9927841 0.6891902
## 15       1m_Jan_in 0.6515307 0.6538105 0.3512270 0.3050282 0.3555949
## 16      1m_Jan_out 0.7364310 0.7317912 0.9687336 0.5470016 0.8868399
## 17       1m_Feb_in 0.6856247 0.6674092 0.3611149 0.3106785 0.3588897
## 18      1m_Feb_out 0.6715170 0.5613361 0.1660205 0.1947078 0.3699352
## 19       1m_Mar_in 0.6603712 0.6656321 0.3539051 0.3023790 0.3530501
## 20      1m_Mar_out 0.5349947 0.5384868 0.1909887 0.2088241 0.3851852
## 21       1m_Apr_in 0.6597906 0.6658463 0.3482126 0.2990208 0.3563215
## 22      1m_Apr_out 0.6605126 0.6709377 0.3355028 0.2833986 0.4879097
##       Sarima
## 1  0.2725827
## 2  0.4186814
## 3  0.2725827
## 4  0.6012078
## 5  0.2655255
## 6  0.6327700
## 7  0.2708815
## 8  0.2926796
## 9  0.2754222
## 10 0.2054855
## 11 0.2725827
## 12 0.2533241
## 13 0.2655255
## 14 0.8870637
## 15 0.2708815
## 16 0.4678975
## 17 0.2754222
## 18 0.1468516
## 19 0.2693435
## 20 0.1734935
## 21 0.2721646
## 22 0.2418188
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out  2.42185488485271  2.40517140567444  2.15285208085992
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  2.50317495996648  2.51071420616879   2.2589643205019
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  2.94324218994747  3.05021113893062  1.99035089593933
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  3.15345143621606  3.17147789239688  4.53390757349255
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out  2.24432329807167  2.23019396058413  1.03777373155899
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out  2.48065023694255  2.46817641736297  2.40426284125621
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out  2.62607600778802  2.69244325136226  2.02984596452465
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  2.84137377443743  2.84704398921894  3.81930887153841
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.676353494652262 0.620905457428594 0.220154760923705
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out  2.52150109191934  2.50090002175195  1.15279466596787
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out  1.72815186029591  1.73028354206183  1.16983687695675
##               hw_mul             Arima            Sarima
## 1                NaN               NaN               NaN
## 2   2.46130027007225  2.39118581025824  1.40525460249044
## 3                NaN               NaN               NaN
## 4   2.43313398617843  2.48648833358686  1.71003120065922
## 5                NaN               NaN               NaN
## 6   1.87222417169747  2.40575563848602  1.62222069380101
## 7                NaN               NaN               NaN
## 8    3.7941741061251  2.50135465975378   1.4343049976313
## 9                NaN               NaN               NaN
## 10  1.60885381507066  2.20200506717963  1.02039410524754
## 11               NaN               NaN               NaN
## 12  2.70959288322267  2.37327010250779  1.45297091409669
## 13               NaN               NaN               NaN
## 14  1.91388482490275  1.82516251706604  1.76319041440316
## 15               NaN               NaN               NaN
## 16  3.09118460927018   2.9498407151449   1.6626348866122
## 17               NaN               NaN               NaN
## 18 0.318561626986709 0.518987849397563 0.207882977134548
## 19               NaN               NaN               NaN
## 20  1.34366115083376  2.18425383977721  1.06480848108438
## 21               NaN               NaN               NaN
## 22    1.101865510774   1.6277505250801 0.790725306183894

8.5.9 comparison by MASE between ARIMA and SARIMA

fc_result_arimasarima(2,1,0,21,7,0,0,0,1,2)

## $MASE
##    forecast_period             Arima            Sarima
## 1    6m_Nov-Apr_in               NaN               NaN
## 2   6m_Nov-Apr_out  2.39118581025824  1.40525460249044
## 3    3m_Nov-Jan_in               NaN               NaN
## 4   3m_Nov-Jan_out  2.48648833358686  1.71003120065922
## 5    3m_Dec-Feb_in               NaN               NaN
## 6   3m_Dec-Feb_out  2.40575563848602  1.62222069380101
## 7    3m_Jan-Mar_in               NaN               NaN
## 8   3m_Jan-Mar_out  2.50135465975378   1.4343049976313
## 9    3m_Feb-Apr_in               NaN               NaN
## 10  3m_Feb-Apr_out  2.20200506717963  1.02039410524754
## 11       1m_Nov_in               NaN               NaN
## 12      1m_Nov_out  2.37327010250779  1.45297091409669
## 13       1m_Dec_in               NaN               NaN
## 14      1m_Dec_out  1.82516251706604  1.76319041440316
## 15       1m_Jan_in               NaN               NaN
## 16      1m_Jan_out   2.9498407151449   1.6626348866122
## 17       1m_Feb_in               NaN               NaN
## 18      1m_Feb_out 0.518987849397563 0.207882977134548
## 19       1m_Mar_in               NaN               NaN
## 20      1m_Mar_out  2.18425383977721  1.06480848108438
## 21       1m_Apr_in               NaN               NaN
## 22      1m_Apr_out   1.6277505250801 0.790725306183894

MLKEP_arimaerror <-data.frame(fc_result_arimasarima(2,1,0,21,7,0,0,0,1,2)) %>% filter(row_number()%%2 ==0)

MLKEP_arimaerror<-txtRound(MLKEP_arimaerror[,-1],2)
MLKEP_arimaerror <- data.frame(forecast_period=fc_timestamp_out,MLKEP_arimaerror) 
htmlTable(MLKEP_arimaerror)

Observations

• Generally, the forecast accuracy of Sarima model perform better than ets models, howerver except 1month forecast of Mar2009 and April2009, all the forecast are worst than the naive model.

8.6.1 apply unit root test plot acf/pacf

# transform data with specific lambda
h03 <- in_sample_dataset_ts[,3]
autoplot(h03)

lambda <- BoxCox.lambda(h03)
lh03 <- BoxCox(h03,lambda)
autoplot(lh03)

# apply unit root test
lh03 %>% ur.kpss() %>% summary()

## 
## ####################### 
## # KPSS Unit Root Test # 
## ####################### 
## 
## Test is of type: mu with 6 lags. 
## 
## Value of test-statistic is: 1.2203 
## 
## Critical value for a significance level of: 
##                 10pct  5pct 2.5pct  1pct
## critical values 0.347 0.463  0.574 0.739

lh03 %>% nsdiffs()

## [1] 1

lh03 %>% diff(lag=7)  %>%  ndiffs()

## [1] 0

lh03 %>%  diff(lag=7) %>%  ur.kpss() %>% summary() #  pass the root test for stationarity

## 
## ####################### 
## # KPSS Unit Root Test # 
## ####################### 
## 
## Test is of type: mu with 6 lags. 
## 
## Value of test-statistic is: 0.0281 
## 
## Critical value for a significance level of: 
##                 10pct  5pct 2.5pct  1pct
## critical values 0.347 0.463  0.574 0.739

# acf pacf
# first diff
lh03 %>% diff() %>% ggtsdisplay(main="first difference")

# seasonal diff
lh03 %>% diff(lag=7) %>%  ggtsdisplay(main="seasonal difference")

# first and second diff
lh03 %>% diff() %>% diff() %>%  ggtsdisplay(main="second difference")

# seasonal diff and first diff
lh03 %>% diff(lag=7) %>% diff() %>%  ggtsdisplay(main="seasonal and first difference")

8.6.2 select parameters for Arima model and plot residuals

# Benchmark AICc=2838.85 ARIMA(2,0,0)(2,1,2)[7] 
#WARUK_1 <- fc_Arima(3,0,1,21)  #AICc=3089.93
#summary(WARUK_1)

WARUK_2 <- fc_Arima(3,6,1,1)  #AICc=3050.76 
summary(WARUK_2)

## Series: in_sample_dataset_ts[, hotel_no] 
## ARIMA(6,1,1) 
## Box Cox transformation: lambda= 0.5416263 
## 
## Coefficients:
##           ar1      ar2      ar3      ar4      ar5      ar6     ma1
##       -0.9628  -0.8862  -0.8303  -0.7489  -0.7223  -0.6998  0.3058
## s.e.   0.0419   0.0443   0.0479   0.0463   0.0410   0.0304  0.0562
## 
## sigma^2 estimated as 14.94:  log likelihood=-1517.25
## AIC=3050.49   AICc=3050.76   BIC=3084.94
## 
## Training set error measures:
##                    ME     RMSE      MAE       MPE     MAPE      MASE
## Training set 1.843925 26.96794 20.99659 -15.49273 37.48797 0.8954405
##                    ACF1
## Training set 0.03452756

checkresiduals(WARUK_2)

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(6,1,1)
## Q* = 41.233, df = 7, p-value = 7.303e-07
## 
## Model df: 7.   Total lags used: 14

#WARUK_3 <- fc_Arima(3,6,1,0)  #AICc=3071.94 
#summary(WARUK_3)

8.6.3 select parameters for SArima model and plot residuals

# Benchmark AICc=2838.85 ARIMA(2,0,0)(2,1,2)[7] 
#WARUK_S1 <- fc_SArima(3,1,0,1,2,1,1)  #AICc=2842.54
#summary(WARUK_S1)

#WARUK_S2 <- fc_SArima(3,1,0,2,2,1,1)  #AICc=2844.02 
#summary(WARUK_S2)

#WARUK_S3 <- fc_SArima(3,1,0,1,3,1,1)  #AICc=2824.48 
#summary(WARUK_S3)

#WARUK_S4 <- fc_SArima(3,0,1,1,0,1,1) #AICc=2902.7
#summary(WARUK_S4)

WARUK_S5 <- fc_SArima(3,8,0,1,2,1,1)  #AICc=2819.74
summary(WARUK_S5)

## Series: in_sample_dataset_ts[, hotel_no] 
## ARIMA(8,0,1)(2,1,1)[7] 
## Box Cox transformation: lambda= 0.5416263 
## 
## Coefficients:
##          ar1     ar2      ar3     ar4     ar5     ar6     ar7     ar8
##       0.0588  0.0689  -0.0174  0.0218  0.0024  0.0718  0.6733  0.0292
## s.e.  0.0905  0.0298   0.0409  0.0419  0.0602  0.0571  0.0080  0.0676
##          ma1     sar1     sar2     sma1
##       0.3538  -0.5415  -0.3284  -0.9994
## s.e.  0.0962   0.1115   0.0446   0.0374
## 
## sigma^2 estimated as 9.9:  log likelihood=-1396.53
## AIC=2819.05   AICc=2819.74   BIC=2874.89
## 
## Training set error measures:
##                     ME     RMSE      MAE       MPE     MAPE      MASE
## Training set 0.7102529 21.90257 16.16122 -11.50519 28.34849 0.6892268
##                    ACF1
## Training set 0.01920445

checkresiduals(WARUK_S5) 

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(8,0,1)(2,1,1)[7]
## Q* = 5.0988, df = 3, p-value = 0.1647
## 
## Model df: 12.   Total lags used: 15

8.6.4 Arima Forecast

fc_Arima_error(3,6,1,1)

##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 20.70676 0.3703259               NaN
## 2   6m_Nov-Apr_out 26.52724 0.7230100  1.19527754309856
## 3    3m_Nov-Jan_in 20.70676 0.3703259               NaN
## 4   3m_Nov-Jan_out 27.87766 0.8772148  1.19512784390653
## 5    3m_Dec-Feb_in 20.67735 0.3822292               NaN
## 6   3m_Dec-Feb_out 27.62729 0.9418174  1.45491867240685
## 7    3m_Jan-Mar_in 20.61937 0.3864812               NaN
## 8   3m_Jan-Mar_out 37.18457 0.5293566  1.85305151574134
## 9    3m_Feb-Apr_in 20.27470 0.3824043               NaN
## 10  3m_Feb-Apr_out 23.33238 0.4917265  1.10987817186834
## 11       1m_Nov_in 20.70676 0.3703259               NaN
## 12      1m_Nov_out 27.26544 0.5532158  1.01484252776394
## 13       1m_Dec_in 20.67735 0.3822292               NaN
## 14      1m_Dec_out 26.51127 1.0892604  1.02347369064707
## 15       1m_Jan_in 20.61937 0.3864812               NaN
## 16      1m_Jan_out 26.10291 0.4777408  1.50687212146416
## 17       1m_Feb_in 20.27470 0.3824043               NaN
## 18      1m_Feb_out 20.49617 0.3413123 0.435757623412606
## 19       1m_Mar_in 20.28507 0.3804409               NaN
## 20      1m_Mar_out 18.25195 0.2917256   1.0176449326799
## 21       1m_Apr_in 20.12943 0.3853128               NaN
## 22      1m_Apr_out 23.82032 0.7483806 0.755401242935939

8.6.5 Arima Prediction interval accuracy

fc_Arima_95pct(3,6,1,1)

##    forecast_period Arima_in_95pc
## 1    6m_Nov-Apr_in     1.0000000
## 2   6m_Nov-Apr_out     1.0000000
## 3    3m_Nov-Jan_in     1.0000000
## 4   3m_Nov-Jan_out     0.9333333
## 5    3m_Dec-Feb_in     1.0000000
## 6   3m_Dec-Feb_out     1.0000000
## 7    3m_Jan-Mar_in     1.0000000
## 8   3m_Jan-Mar_out     0.8387097
## 9    3m_Feb-Apr_in     1.0000000
## 10  3m_Feb-Apr_out     1.0000000
## 11       1m_Nov_in     0.9333333
## 12      1m_Nov_out     1.0000000
## 13       1m_Dec_in     1.0000000
## 14      1m_Dec_out     1.0000000
## 15       1m_Jan_in     0.9333333
## 16      1m_Jan_out     1.0000000
## 17       1m_Feb_in     1.0000000
## 18      1m_Feb_out     1.0000000
## 19       1m_Mar_in     0.8387097
## 20      1m_Mar_out     1.0000000
## 21       1m_Apr_in     1.0000000
## 22      1m_Apr_out     0.9333333

Observations

• the 95percent prediction are quite robust and stable enough, all records are 100% fall inside the interval except 3 month forecast of FEB 2009 and 1month forecast of Mar2010 which have more than 5% records fall out the interval

8.6.6 Seasonal Arima Forecast

fc_SArima_error(3,8,0,1,2,1,1)

##    forecast_period      MAE      MAPE              MASE
## 1    6m_Nov-Apr_in 15.84349 0.2875175               NaN
## 2   6m_Nov-Apr_out 21.29873 0.6557749 0.959688942439446
## 3    3m_Nov-Jan_in 15.84349 0.2875175               NaN
## 4   3m_Nov-Jan_out 25.02444 0.8917202  1.07280898867372
## 5    3m_Dec-Feb_in 15.88532 0.2890496               NaN
## 6   3m_Dec-Feb_out 23.60316 0.8286613  1.24299822402762
## 7    3m_Jan-Mar_in 16.08653 0.3058562               NaN
## 8   3m_Jan-Mar_out 25.68798 0.4002496  1.58133921290795
## 9    3m_Feb-Apr_in 15.92285 0.3037107               NaN
## 10  3m_Feb-Apr_out 19.40728 0.3589227 0.923168199447218
## 11       1m_Nov_in 15.84349 0.2875175               NaN
## 12      1m_Nov_out 18.68239 0.4104857 0.695374142575834
## 13       1m_Dec_in 15.88532 0.2890496               NaN
## 14      1m_Dec_out 31.23456 1.3064874  1.20581754966476
## 15       1m_Jan_in 16.08653 0.3058562               NaN
## 16      1m_Jan_out 21.75883 0.4729108  1.25609650300468
## 17       1m_Feb_in 15.92285 0.3037107               NaN
## 18      1m_Feb_out 17.85865 0.2609324 0.379682774598811
## 19       1m_Mar_in 15.95166 0.3022490               NaN
## 20      1m_Mar_out 16.00217 0.2317217 0.892207532174453
## 21       1m_Apr_in 15.86604 0.3034632               NaN
## 22      1m_Apr_out 17.38110 0.5815646 0.551197655068417

8.6.7 SArima Prediction interval accuracy

fc_SArima_95pct(3,8,0,1,2,1,1)

##    forecast_period SArima_in_95pc
## 1    6m_Nov-Apr_in      0.9281768
## 2   6m_Nov-Apr_out      0.8695652
## 3    3m_Nov-Jan_in      0.9000000
## 4   3m_Nov-Jan_out      0.9444444
## 5    3m_Dec-Feb_in      0.9775281
## 6   3m_Dec-Feb_out      0.9666667
## 7    3m_Jan-Mar_in      0.7741935
## 8   3m_Jan-Mar_out      0.9032258
## 9    3m_Feb-Apr_in      0.9642857
## 10  3m_Feb-Apr_out      1.0000000
## 11       1m_Nov_in      0.9000000
## 12      1m_Nov_out      0.9281768
## 13       1m_Dec_in      0.8695652
## 14      1m_Dec_out      0.9000000
## 15       1m_Jan_in      0.9444444
## 16      1m_Jan_out      0.9775281
## 17       1m_Feb_in      0.9666667
## 18      1m_Feb_out      0.7741935
## 19       1m_Mar_in      0.9032258
## 20      1m_Mar_out      0.9642857
## 21       1m_Apr_in      1.0000000
## 22      1m_Apr_out      0.9000000

WARUK_95interval <- cbind(fc_Arima_95pct(3,6,1,1),fc_SArima_95pct(3,8,0,1,2,1,1)[2])
WARUK_95interval <- txtRound(WARUK_95interval[-1],2)
WARUK_95interval <- data.frame(forecast_period = fc_timestamp,WARUK_95interval)
htmlTable(WARUK_95interval)

8.6.8 comparison by MASE between ARIMA and SARIMA

fc_result_arimasarima(3,6,1,1,8,0,1,2,1,1)

## $MASE
##    forecast_period             Arima            Sarima
## 1    6m_Nov-Apr_in               NaN               NaN
## 2   6m_Nov-Apr_out  1.19527754309856 0.959688942439446
## 3    3m_Nov-Jan_in               NaN               NaN
## 4   3m_Nov-Jan_out  1.19512784390653  1.07280898867372
## 5    3m_Dec-Feb_in               NaN               NaN
## 6   3m_Dec-Feb_out  1.45491867240685  1.24299822402762
## 7    3m_Jan-Mar_in               NaN               NaN
## 8   3m_Jan-Mar_out  1.85305151574134  1.58133921290795
## 9    3m_Feb-Apr_in               NaN               NaN
## 10  3m_Feb-Apr_out  1.10987817186834 0.923168199447218
## 11       1m_Nov_in               NaN               NaN
## 12      1m_Nov_out  1.01484252776394 0.695374142575834
## 13       1m_Dec_in               NaN               NaN
## 14      1m_Dec_out  1.02347369064707  1.20581754966476
## 15       1m_Jan_in               NaN               NaN
## 16      1m_Jan_out  1.50687212146416  1.25609650300468
## 17       1m_Feb_in               NaN               NaN
## 18      1m_Feb_out 0.435757623412606 0.379682774598811
## 19       1m_Mar_in               NaN               NaN
## 20      1m_Mar_out   1.0176449326799 0.892207532174453
## 21       1m_Apr_in               NaN               NaN
## 22      1m_Apr_out 0.755401242935939 0.551197655068417

WARUK_arimaerror <-data.frame(fc_result_arimasarima(3,6,1,1,8,0,1,2,1,1)) %>% filter(row_number()%%2 ==0)

WARUK_arimaerror<-txtRound(WARUK_arimaerror[,-1],2)
WARUK_arimaerror <- data.frame(forecast_period=fc_timestamp_out,WARUK_arimaerror) 
htmlTable(WARUK_arimaerror)

Observations

• the 95percent prediction are quite robust and stable enough, except one month forecast of FEB 2009 that more than 5% records fall outside the 95pct interval

8.6.9 Comparison by MAE, MAPE and MASE across 6 models

fc_result_across2(3,6,1,1,8,0,1,2,1,1)

## $MAE
##    forecast_period      ses     holt   hw_add   hw_mul    Arima   Sarima
## 1    6m_Nov-Apr_in 28.82098 28.79836 19.16986 19.36768 20.70676 15.84349
## 2   6m_Nov-Apr_out 29.13186 28.22814 20.94382 21.78586 26.52724 21.29873
## 3    3m_Nov-Jan_in 28.82098 28.79836 19.16986 19.36768 20.70676 15.84349
## 4   3m_Nov-Jan_out 33.14034 31.89648 23.93825 25.33373 27.87766 25.02444
## 5    3m_Dec-Feb_in 28.91952 28.90371 19.09842 19.28285 20.67735 15.88532
## 6   3m_Dec-Feb_out 30.47796 29.87686 23.55038 23.37988 27.62729 23.60316
## 7    3m_Jan-Mar_in 28.77723 28.70823 19.31966 19.52529 20.61937 16.08653
## 8   3m_Jan-Mar_out 28.96293 31.91232 30.96454 24.38654 37.18457 25.68798
## 9    3m_Feb-Apr_in 28.64621 28.54008 19.02623 19.36195 20.27470 15.92285
## 10  3m_Feb-Apr_out 27.11680 27.87490 17.72514 19.19334 23.33238 19.40728
## 11       1m_Nov_in 28.82098 28.79836 19.16986 19.36768 20.70676 15.84349
## 12      1m_Nov_out 30.12265 29.93947 19.17861 18.43681 27.26544 18.68239
## 13       1m_Dec_in 28.91952 28.90371 19.09842 19.28285 20.67735 15.88532
## 14      1m_Dec_out 31.30868 30.63154 30.23650 30.10730 26.51127 31.23456
## 15       1m_Jan_in 28.77723 28.70823 19.31966 19.52529 20.61937 16.08653
## 16      1m_Jan_out 26.23703 25.05556 21.53150 19.87277 26.10291 21.75883
## 17       1m_Feb_in 28.89159 28.54008 19.02623 19.35917 20.27470 15.92285
## 18      1m_Feb_out 25.39501 27.76141 16.25180 17.38830 20.49617 17.85865
## 19       1m_Mar_in 28.55806 28.45956 19.04268 19.30929 20.28507 15.95166
## 20      1m_Mar_out 23.27438 23.27199 15.59887 15.90344 18.25195 16.00217
## 21       1m_Apr_in 28.29187 28.20198 18.85216 19.13959 20.12943 15.86604
## 22      1m_Apr_out 27.20959 27.45437 17.78947 17.83321 23.82032 17.38110
## 
## $MAPE
##    forecast_period       ses      holt    hw_add    hw_mul     Arima
## 1    6m_Nov-Apr_in 0.5909103 0.5821914 0.3505977 0.3553212 0.3703259
## 2   6m_Nov-Apr_out 0.9553429 0.8959336 0.5997629 0.6848645 0.7230100
## 3    3m_Nov-Jan_in 0.5909103 0.5821914 0.3505977 0.3553212 0.3703259
## 4   3m_Nov-Jan_out 1.2042130 1.1336424 0.8104840 0.9187168 0.8772148
## 5    3m_Dec-Feb_in 0.6010551 0.5917624 0.3515533 0.3578109 0.3822292
## 6   3m_Dec-Feb_out 1.0926923 1.0544110 0.8333053 0.8281398 0.9418174
## 7    3m_Jan-Mar_in 0.6208548 0.6078258 0.3814761 0.3877467 0.3864812
## 8   3m_Jan-Mar_out 0.5738793 0.5461635 0.5191572 0.4169745 0.5293566
## 9    3m_Feb-Apr_in 0.6265531 0.6119436 0.3763300 0.3857044 0.3824043
## 10  3m_Feb-Apr_out 0.5314595 0.5255231 0.3558995 0.3592458 0.4917265
## 11       1m_Nov_in 0.5909103 0.5821914 0.3505977 0.3553212 0.3703259
## 12      1m_Nov_out 0.7882818 0.7553887 0.3820458 0.4285194 0.5532158
## 13       1m_Dec_in 0.6010551 0.5917624 0.3515533 0.3578109 0.3822292
## 14      1m_Dec_out 1.2925213 1.2530115 1.2707635 1.2717348 1.0892604
## 15       1m_Jan_in 0.6208548 0.6078258 0.3814761 0.3877467 0.3864812
## 16      1m_Jan_out 0.7778604 0.6536619 0.4571971 0.4746228 0.4777408
## 17       1m_Feb_in 0.5640120 0.6119436 0.3763300 0.3856014 0.3824043
## 18      1m_Feb_out 0.4730915 0.4712047 0.2449163 0.2507572 0.3413123
## 19       1m_Mar_in 0.6216608 0.6096108 0.3745319 0.3815645 0.3804409
## 20      1m_Mar_out 0.4550559 0.4559024 0.2468240 0.2447211 0.2917256
## 21       1m_Apr_in 0.6148704 0.6046627 0.3689643 0.3752048 0.3853128
## 22      1m_Apr_out 0.9348579 0.9482544 0.6148652 0.6452088 0.7483806
##       Sarima
## 1  0.2875175
## 2  0.6557749
## 3  0.2875175
## 4  0.8917202
## 5  0.2890496
## 6  0.8286613
## 7  0.3058562
## 8  0.4002496
## 9  0.3037107
## 10 0.3589227
## 11 0.2875175
## 12 0.4104857
## 13 0.2890496
## 14 1.3064874
## 15 0.3058562
## 16 0.4729108
## 17 0.3037107
## 18 0.2609324
## 19 0.3022490
## 20 0.2317217
## 21 0.3034632
## 22 0.5815646
## 
## $MASE
##    forecast_period               ses              holt            hw_add
## 1    6m_Nov-Apr_in               NaN               NaN               NaN
## 2   6m_Nov-Apr_out   1.3126381075586  1.27191747493191 0.943697112193449
## 3    3m_Nov-Jan_in               NaN               NaN               NaN
## 4   3m_Nov-Jan_out  1.42074162101984  1.36741660311895  1.02624367542471
## 5    3m_Dec-Feb_in               NaN               NaN               NaN
## 6   3m_Dec-Feb_out  1.60504186201305  1.57338646187902  1.24021917817597
## 7    3m_Jan-Mar_in               NaN               NaN               NaN
## 8   3m_Jan-Mar_out  1.78294381881824  1.96450677908921  1.90616194938938
## 9    3m_Feb-Apr_in               NaN               NaN               NaN
## 10  3m_Feb-Apr_out   1.2898960615447  1.32595706973114 0.843151851359788
## 11       1m_Nov_in               NaN               NaN               NaN
## 12      1m_Nov_out  1.12119051317152  1.11437240413335  0.71384406279644
## 13       1m_Dec_in               NaN               NaN               NaN
## 14      1m_Dec_out  1.20867897915411  1.18253756938824  1.16728704340749
## 15       1m_Jan_in               NaN               NaN               NaN
## 16      1m_Jan_out  1.51461459948899   1.4464104266271  1.24297305019322
## 17       1m_Feb_in               NaN               NaN               NaN
## 18      1m_Feb_out 0.539909198327349 0.590219869373757  0.34552033919289
## 19       1m_Mar_in               NaN               NaN               NaN
## 20      1m_Mar_out  1.29767225528038  1.29753915255108 0.869721349584206
## 21       1m_Apr_in               NaN               NaN               NaN
## 22      1m_Apr_out 0.862883557035178 0.870646128538007 0.564148231682622
##               hw_mul             Arima            Sarima
## 1                NaN               NaN               NaN
## 2  0.981638060456886  1.19527754309856 0.959688942439446
## 3                NaN               NaN               NaN
## 4   1.08606865222246  1.19512784390653  1.07280898867372
## 5                NaN               NaN               NaN
## 6   1.23123977404581  1.45491867240685  1.24299822402762
## 7                NaN               NaN               NaN
## 8   1.50122333299401  1.85305151574134  1.58133921290795
## 9                NaN               NaN               NaN
## 10 0.912991470803143  1.10987817186834 0.923168199447218
## 11               NaN               NaN               NaN
## 12 0.686233451964408  1.01484252776394 0.695374142575834
## 13               NaN               NaN               NaN
## 14  1.16229916161656  1.02347369064707  1.20581754966476
## 15               NaN               NaN               NaN
## 16  1.14721773195554  1.50687212146416  1.25609650300468
## 17               NaN               NaN               NaN
## 18 0.369682990947948 0.435757623412606 0.379682774598811
## 19               NaN               NaN               NaN
## 20  0.88670257462673   1.0176449326799 0.892207532174453
## 21               NaN               NaN               NaN
## 22 0.565535116533899 0.755401242935939 0.551197655068417

Observations

• Generally, the forecast accuracy of Sarima model for outperform accoss all models in most of the months forcast except the 1month for Dec2009 and Jan2010, which are worst than the naive model.

9.1.1 create forecast loop function for holt-winter model for training data

# holt winter forecast function
fc_hw_loop <- function(traintime1,traintime2,hotel_no,testtime1,testtime2,season) {
  
  # create holt-winters forecast function
  fc_hw<- function(traintime1,traintime2,hotel_no,testtime1,testtime2,season) {
  k = abs(as.numeric(difftime(traintime1, traintime2, unit = "day"))) + 1
  k1= abs(as.numeric(difftime(testtime1, testtime2, unit = "day"))) + 1
  training_ts <- subset(smoothing_dataset_ts,end=k)
  fc_ts<- hw(training_ts[,hotel_no],h=k1,seasonal=season,damped = TRUE)
  return(fc_ts)
}


# Initiate rolling forecast 
fcday1 <-fc_hw(traintime1,traintime2, hotel_no ,testtime1,testtime2, season)
fc <- data.frame(forecast = as.numeric(fcday1$mean),stay_date = (seq(as.Date(testtime1), as.Date(testtime2),by="day")),CONF_DT=as.Date(traintime2) )

# create loop and forecast
for (delta in 1: (as.numeric(difftime(testtime2, testtime1, unit = "day"))-1)) {

  hwtest <- fc_hw(as.Date(traintime1), as.Date(traintime2) + delta,hotel_no,as.Date(testtime1) + delta, as.Date(testtime2), season)
  hwtest_mean <- data.frame(forecast=as.numeric(hwtest$mean),stay_date = (seq(as.Date(testtime1) + delta,  as.Date(testtime2),by="day")),CONF_DT=as.Date(traintime2) + delta)


  fc <- rbind(fc, hwtest_mean)
}

 fc<- fc %>% mutate(days_prior = stay_date-CONF_DT,hotel=ifelse(hotel_no == 1 ,"GLWST",
                                                                ifelse(hotel_no == 2,"MLKEP","WARUK")))
 return(fc)
}

9.1.2 create forecast function using holt-winter model for out sample

# holt winter forecast function
fc_hw_daysprior <- function(hotel_no,season) {
  
  
# hw_add
# six-month forecasting errors
six_month_hw <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-04-30",season) 
fc1 <- data.frame(forecast = as.numeric(six_month_hw$mean),stay_date = (seq(as.Date("2009-11-01"), as.Date("2010-04-30"),by="day")),CONF_DT=as.Date("2009-10-31"),forecast_period= "6m_Nov-Apr_out")

# three-month forecasting errors
three_month_1_hw  <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2010-01-31", season)
fc2 <- data.frame(forecast = as.numeric(three_month_1_hw$mean),stay_date = (seq(as.Date("2009-11-01"), as.Date("2010-01-31",),by="day")),CONF_DT=as.Date("2009-10-31"),forecast_period= "3m_Nov-Jan_out" )

three_month_2_hw  <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2010-02-28", season)
fc3 <- data.frame(forecast = as.numeric(three_month_2_hw$mean),stay_date = (seq(as.Date("2009-12-01"), as.Date("2010-02-28",),by="day")),CONF_DT=as.Date("2009-11-30"),forecast_period= "3m_Dec-Feb_out" )

three_month_3_hw  <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-03-31", season)
fc4 <- data.frame(forecast = as.numeric(three_month_3_hw$mean),stay_date = (seq(as.Date("2010-01-01"), as.Date("2010-03-31",),by="day")),CONF_DT=as.Date("2009-12-31"),forecast_period= "3m_Jan-Mar_out" )

three_month_4_hw  <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-04-30", season)
fc5 <- data.frame(forecast = as.numeric(three_month_4_hw$mean),stay_date = (seq(as.Date("2010-02-01"), as.Date("2010-04-30"),by="day")),CONF_DT=as.Date("2010-01-31"),forecast_period= "3m_Feb-Apr_out" )

# one-month forecasting errors
one_month_1_hw  <-fc_hw("2008-05-01","2009-10-31",hotel_no,"2009-11-01","2009-11-30", season)
fc6 <- data.frame(forecast = as.numeric(one_month_1_hw$mean),stay_date = (seq(as.Date("2009-11-01"), as.Date("2009-11-30"),by="day")),CONF_DT=as.Date("2009-10-31"),forecast_period= "1m_Nov_out" )

one_month_2_hw  <-fc_hw("2008-05-01","2009-11-30",hotel_no,"2009-12-01","2009-12-31", season)
fc7 <- data.frame(forecast = as.numeric(one_month_2_hw$mean),stay_date = (seq(as.Date("2009-12-01"), as.Date("2009-12-31"),by="day")),CONF_DT=as.Date("2009-11-30"),forecast_period= "1m_Dec_out" )

one_month_3_hw  <-fc_hw("2008-05-01","2009-12-31",hotel_no,"2010-01-01","2010-01-31", season) 
fc8 <- data.frame(forecast = as.numeric(one_month_3_hw$mean),stay_date = (seq(as.Date("2010-01-01"), as.Date("2010-01-31"),by="day")),CONF_DT=as.Date("2009-12-31"),forecast_period= "1m_Jan_out" )

one_month_4_hw  <-fc_hw("2008-05-01","2010-01-31",hotel_no,"2010-02-01","2010-02-28", season) 
fc9 <- data.frame(forecast = as.numeric(one_month_4_hw$mean),stay_date = (seq(as.Date("2010-02-01"), as.Date("2010-02-28"),by="day")),CONF_DT=as.Date("2010-01-31"),forecast_period= "1m_Feb_out" )

one_month_5_hw  <-fc_hw("2008-05-01","2010-02-28",hotel_no,"2010-03-01","2010-03-31", season) 
fc10 <- data.frame(forecast = as.numeric(one_month_5_hw$mean),stay_date = (seq(as.Date("2010-03-01"), as.Date("2010-03-31"),by="day")),CONF_DT=as.Date("2010-02-28"),forecast_period= "1m_Mar_out" )

one_month_6_hw  <-fc_hw("2008-05-01","2010-03-31",hotel_no,"2010-04-01","2010-04-30", season)
fc11 <- data.frame(forecast = as.numeric(one_month_6_hw$mean),stay_date = (seq(as.Date("2010-04-01"), as.Date("2010-04-30"),by="day")),CONF_DT=as.Date("2010-03-31"),forecast_period= "1m_Apr_out" )


# merge data
result <- rbind(fc1,fc2,fc3,fc4,fc5,fc6,fc7,fc8,fc9,fc10,fc11)
result <- result %>% mutate(hotel=ifelse(hotel_no == 1 ,"GLWST",
                                                                ifelse(hotel_no == 2,"MLKEP","WARUK")))
return(result)
}

9.1.3 create forecast weight function

fc_combined_weight<- function(dataset,hotel_name,model1,model2,factor) { 
  
  if(factor == "days_prior_c") {
    # days prior '1-7'
  hotel_dataset1 <- dataset %>% 
  filter(hotel == hotel_name,days_prior_c == '1 to 7')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod1 <- lm(formula,data = hotel_dataset1 )
  hotel_dataset1 <- hotel_dataset1 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod1$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod1$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod1$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod1$coefficients[3])
  
# days prior '8-14'
    hotel_dataset2 <- dataset %>% 
  filter(hotel == hotel_name,days_prior_c == '8 to 14')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = "+"), 
        sep = " ~ "))
  linearMod2 <- lm(formula,data = hotel_dataset2 )
  hotel_dataset2 <- hotel_dataset2 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod2$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod2$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod2$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod2$coefficients[3])
  
# days prior '15-21'
    hotel_dataset3 <- dataset %>% 
  filter(hotel == hotel_name,days_prior_c == '15 to 21')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod3 <- lm(formula,data = hotel_dataset3 )
  hotel_dataset3 <- hotel_dataset3 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod3$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod3$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod3$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod3$coefficients[3])
  
# days prior '22-28'
  hotel_dataset4 <- dataset %>% 
  filter(hotel == hotel_name,days_prior_c == '22 to 28')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod4 <- lm(formula,data = hotel_dataset4 )
  hotel_dataset4 <- hotel_dataset4 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod4$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod4$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod4$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod4$coefficients[3])
  
# days prior '29-60'
    hotel_dataset5 <- dataset %>% 
  filter(hotel == hotel_name,days_prior_c == '29 to 60')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod5 <- lm(formula,data = hotel_dataset5 )
  hotel_dataset5 <- hotel_dataset5 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod5$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod5$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod5$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod5$coefficients[3])

# days prior '60 or more'
   hotel_dataset6 <- dataset %>% 
  filter(hotel == hotel_name,days_prior_c == '60 or more')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod6 <- lm(formula,data = hotel_dataset6 )
  hotel_dataset6 <- hotel_dataset6 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod6$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod6$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod6$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod6$coefficients[3])
  
  hotel_dataset<-rbind(hotel_dataset1,hotel_dataset2,hotel_dataset3,hotel_dataset4,hotel_dataset5,hotel_dataset6)
  
  result <- list('1 to 7'=linearMod1,'8 to 14'=linearMod2,'15 to 21'= linearMod3,'22 to 28'=linearMod4,
              '29 to 60'= linearMod5,'60 or more'= linearMod6,dataset=hotel_dataset)
  } else {
 
# DOW 'Sun'
  hotel_dataset1 <- dataset %>% 
  filter(hotel == hotel_name,DOW == 'Sun')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod1 <- lm(formula,data = hotel_dataset1 )
  hotel_dataset1 <- hotel_dataset1 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod1$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod1$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod1$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod1$coefficients[3])
  
# DOW 'Mon'
    hotel_dataset2 <- dataset %>% 
  filter(hotel == hotel_name,DOW == 'Mon')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = "+"), 
        sep = " ~ "))
  linearMod2 <- lm(formula,data = hotel_dataset2 )
  hotel_dataset2 <- hotel_dataset2 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod2$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod2$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod2$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod2$coefficients[3])
  
# DOW 'Tue'
    hotel_dataset3 <- dataset %>% 
  filter(hotel == hotel_name,DOW == 'Tue')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod3 <- lm(formula,data = hotel_dataset3 )
  hotel_dataset3 <- hotel_dataset3 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod3$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod3$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod3$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod3$coefficients[3])
  
# DOW 'Wed'
  hotel_dataset4 <- dataset %>% 
  filter(hotel == hotel_name,DOW == 'Wed')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod4 <- lm(formula,data = hotel_dataset4 )
  hotel_dataset4 <- hotel_dataset4 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod4$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod4$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod4$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod4$coefficients[3])
  
 # DOW 'Thu'
    hotel_dataset5 <- dataset %>% 
  filter(hotel == hotel_name,DOW == 'Thu')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod5 <- lm(formula,data = hotel_dataset5 )
  hotel_dataset5 <- hotel_dataset5 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod5$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod5$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod5$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod5$coefficients[3])

# DOW 'Fri'
   hotel_dataset6 <- dataset %>% 
  filter(hotel == hotel_name,DOW == 'Fri')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod6 <- lm(formula,data = hotel_dataset6 )
  hotel_dataset6 <- hotel_dataset6 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod6$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod6$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod6$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod6$coefficients[3])
  
  # DOW 'Sat'
  hotel_dataset7 <- dataset %>% 
  filter(hotel == hotel_name,DOW == 'Sat')
  formula <- as.formula(
    paste("final_arrivals", 
        paste(c(model1,model2), collapse = " + "), 
        sep = " ~ "))
  linearMod7 <- lm(formula,data = hotel_dataset7 )
  hotel_dataset7 <- hotel_dataset7 %>% 
    mutate(!!paste(c(model1,model2),collapse = ".") :=  linearMod7$fitted.values,
           !!paste(c("interc",model1,model2),collapse = ".") :=linearMod6$coefficients[1],
           !!paste(c("coef1",model1,model2),collapse = ".") :=  linearMod6$coefficients[2],
           !!paste(c("coef2",model1,model2),collapse = ".") :=  linearMod6$coefficients[3])
  
  hotel_dataset<-rbind(hotel_dataset1,hotel_dataset2,hotel_dataset3,hotel_dataset4,hotel_dataset5,hotel_dataset6,hotel_dataset7)
  result<-list('Sun'=linearMod1,'Mon'=linearMod2,'Tue'= linearMod3,'Wed'=linearMod4,
              'Thu'= linearMod5,'Fri'= linearMod6,'Sat'= linearMod7,dataset=hotel_dataset) }
  
  
  return(result)
}

9.1.4 create cross erros results functions for combined models in training data

cross_result_error <- function(hotelname,factor) {
  
cross_result <- function(dataset,hotel_name,model1,model2,factor) { 
  
  # run the combined function
  fc_combined<-fc_combined_weight(dataset,hotel_name,model1,model2,factor) 
  dataset <-  fc_combined$dataset
  dataset_error <- dataset %>%
       group_by_(factor) %>% 
            # MAE error measurements
  summarise(MAE_add = sum(abs(fc_add- final_arrivals))/n(),
            MAE_mul = sum(abs(fc_mul-final_arrivals))/n(),
            MAE_add_mDOW = sum(abs(fc_add_mDOW -final_arrivals))/n(),
            !!paste(c("MAE",model1,model2),collapse = "_") := sum(abs(get(paste(c(model1,model2),collapse = ".")) - final_arrivals))/n(),
  
            # MAPE error measurements
            MAPE_add = sum(abs(fc_add - final_arrivals)/final_arrivals)/n(),
            MAPE_mul = sum(abs(fc_mul - final_arrivals)/final_arrivals)/n(),
            MAPE_add_mDOW = sum(abs(fc_add_mDOW - final_arrivals)/final_arrivals)/n(),
            !!paste(c("MAPE",model1,model2),collapse = "_") := sum(abs(get(paste(c(model1,model2),collapse = "."))- final_arrivals)/final_arrivals)/n())
                                
return(dataset_error)
}

# fit combined modle1 and get error result
result1 <- cross_result(in_compare_dataset,hotelname,"fc_add","fc_hw_a",factor)                     

## MAE, MAPE 
result1_MAE <- result1[names(result1) %like% "MAE" | names(result1) == factor]
result1_MAPE <- result1[names(result1) %like% "MAPE" | names(result1) == factor]


# fit combined modle2 and get error result
result2 <- cross_result(in_compare_dataset,hotelname,"fc_add","fc_hw_m",factor)                     

## MAE, MAPE errors
result2_MAE <- result2[,ncol(result2)-4]
result2_MAPE <-result2[,ncol(result2)]


# fit combined modle3 and get error result
result3 <- cross_result(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_a",factor)                     

## MAE, MAPE errors
result3_MAE <- result3[,ncol(result2)-4]
result3_MAPE <-result3[,ncol(result2)]

# final result
result_MAE <- cbind(result1_MAE,result2_MAE,result3_MAE) 
result_MAPE <- cbind(result1_MAPE,result2_MAPE,result3_MAPE)
 
 return(list(result_MAE, result_MAPE))
 
}

9.1.5 create out compare dataset function for out sample

out_compare_dataset <- function(hotelname,factor) {
# fit combined models to get coefficient from training data

fc1<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add","fc_hw_a",factor) 
dataset1<-fc1$dataset
fc2<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_a",factor) 
dataset2<-fc2$dataset
fc3<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_m",factor) 
dataset3<-fc3$dataset

# store the combined model parameters as parameter datasets for later join with out-sample data
coe_fc_add.fc_hw_a <- dataset1[,c(1,which(names(dataset1) == factor),(ncol(dataset1)-2):ncol(dataset1))] %>% distinct()
coe_fc_add_mDOW.fc_hw_a <- dataset2[,c(1,which(names(dataset2) == factor),(ncol(dataset2)-2):ncol(dataset2))] %>% distinct()
coe_fc_add_mDOW.fc_hw_m <- dataset3[,c(1,which(names(dataset3) == factor),(ncol(dataset3)-2):ncol(dataset3))] %>% distinct()

# get out-sample forecast data using hw_additive and hw multiplicative model
if(hotelname == "GLWST") {
   hotelno<-1
} else if (hotelname == "MLKEP") {
    hotelno<-2
} else {
  hotelno<-3}

# result from the best model from ets method
result_hw_a<-fc_hw_daysprior(hotelno,"additive") %>% rename(fc_hw_a=forecast)
result_hw_w<-fc_hw_daysprior(hotelno,"multiplicative") %>% rename(fc_hw_m=forecast)

# merge out-sample dataset with the advance booking model
out_compare_dataset<- valid_dataset %>%
  select(c("hotel","days_prior_c","month","DOW","days_prior","CONF_DT","stay_date","final_arrivals","fc_naive","fc_add_mDOW","fc_add","fc_mul")) %>%
  # merge with the hw_additive and hw_multiplicative forecast data
  merge(result_hw_a, by = c("hotel","CONF_DT","stay_date")) %>%
  merge(result_hw_w, by = c("hotel","stay_date","CONF_DT","forecast_period"))  %>%
  # merge with the parameters dataset calculated from in sample dataset
  merge(coe_fc_add.fc_hw_a, by = c("hotel",factor)) %>%
  merge(coe_fc_add_mDOW.fc_hw_a, by = c("hotel",factor))  %>%
  merge(coe_fc_add_mDOW.fc_hw_m, by = c("hotel",factor))  %>% 
  filter(days_prior!=0)  %>%  # filter out final_day forecast

  # model combined fc_add and fc_hw_a 
  mutate(fc_add.fc_hw_a = interc.fc_add.fc_hw_a + coef1.fc_add.fc_hw_a*fc_add + coef2.fc_add.fc_hw_a*fc_hw_a ) %>% 
  # model combined fc_mDOW and fc_hw_a 
  mutate(fc_add_mDOW.fc_hw_a = interc.fc_add_mDOW.fc_hw_a + coef1.fc_add_mDOW.fc_hw_a*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_a *fc_hw_a ) %>%
  # model combined fc_mDOW and fc_hw_m
  mutate(fc_add_mDOW.fc_hw_m = interc.fc_add_mDOW.fc_hw_m + coef1.fc_add_mDOW.fc_hw_m*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_m *fc_hw_m )  %>% select(-(16:24))  # drop columns with the coefficient datas
  # drop NA rows from the out compare dataset
  out_compare_dataset <- na.omit(out_compare_dataset)

return(out_compare_dataset)
}

9.1.6 create errors comparision function for out-sample

out_crosss_result_error <- function(hotelname,factor) {
  result_hotel <- out_compare_dataset(hotelname,factor) %>% 
  group_by(forecast_period,hotel) %>% 
            # MAE error measurements
  summarise(MAE_naive =  sum(abs(fc_naive- final_arrivals))/n(),
            MAE_add = sum(abs(fc_add- final_arrivals))/n(),
            MAE_mul = sum(abs(fc_mul-final_arrivals))/n(),
            MAE_add_mDOW = sum(abs(fc_add_mDOW-final_arrivals))/n(),
            MAE_fc_add.fc_hw_a = sum(abs(fc_add.fc_hw_a-final_arrivals))/n(),
            MAE_fc_add_mDOW.fc_hw_a = sum(abs(fc_add_mDOW.fc_hw_a-final_arrivals))/n(),
            MAE_fc_add_mDOW.fc_hw_m = sum(abs(fc_add_mDOW.fc_hw_m-final_arrivals))/n(),
            
            # MAPE error measurements
            MAPE_add = sum(abs(fc_add - final_arrivals)/final_arrivals)/n(),
            MAPE_mul = sum(abs(fc_mul - final_arrivals)/final_arrivals)/n(),
            MAPE_add_mDOW = sum(abs(fc_add_mDOW - final_arrivals)/final_arrivals)/n(),
            MAPE_fc_add.fc_hw_a = sum(abs(fc_add.fc_hw_a-final_arrivals)/final_arrivals)/n(),
            MAPE_fc_add_mDOW.fc_hw_a = sum(abs(fc_add_mDOW.fc_hw_a-final_arrivals)/final_arrivals)/n(),
            MAPE_fc_add_mDOW.fc_hw_m = sum(abs(fc_add_mDOW.fc_hw_m-final_arrivals)/final_arrivals)/n(),
            
            # MASE error measurements compared to naive model
            MASE_add = MAE_add/MAE_naive,
            MASE_mul = MAE_mul/MAE_naive,
            MASE_add_mDOW = MAE_add_mDOW/MAE_naive,
            MASE_fc_add.fc_hw_a = MAE_fc_add.fc_hw_a/MAE_naive,
            MASE_fc_add_mDOW.fc_hw_a = MAE_fc_add_mDOW.fc_hw_a/MAE_naive, 
            MASE_fc_add_mDOW.fc_hw_m = MAE_fc_add_mDOW.fc_hw_m/MAE_naive)


result_MAE <- result_hotel[names(result_hotel) %like% "MAE" | names(result_hotel) == "forecast_period"] 
result_MAPE <- result_hotel[names(result_hotel) %like% "MAPE" | names(result_hotel) == "forecast_period"]
result_MASE <- result_hotel[names(result_hotel) %like% "MASE" | names(result_hotel) == "forecast_period"] 

return(list(result_MAE,result_MAPE,result_MASE))

}

9.3.1 try different combinations of models and fit weight for each combined model using regression

# by days prior category
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add","fc_hw_a","days_prior_c") 
weight1 <- list.remove(fc1,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##      0.3485       0.8114       0.1830  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##      6.4373       0.6911       0.2437  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##      2.7314       0.6713       0.3002  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##      7.7915       0.6668       0.2559  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     15.1555       0.7003       0.1534  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    37.54891      0.61860      0.05243

#fc1$dataset

## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_a","days_prior_c") 
weight2 <- list.remove(fc2,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##      2.8148       0.8562       0.1154  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    10.56695      0.80970      0.08643  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##      9.3582       0.8027       0.1056  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    13.13990      0.79155      0.08046  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    14.31468      0.83483      0.02873  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    20.07251      0.85079     -0.02438

#fc3$dataset

## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_m","days_prior_c") 
weight3 <- list.remove(fc3,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##      2.6859       0.8565       0.1161  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    10.16474      0.80783      0.09202  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##      9.3273       0.8022       0.1062  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    13.67648      0.79383      0.07281  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    14.12744      0.83407      0.03122  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     19.5327       0.8503      -0.0184

#fc4$dataset


# by DOW
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add","fc_hw_a","DOW") 
weight1 <- list.remove(fc1,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -16.5531       1.1405      -0.1397  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    25.24525      0.80229     -0.04772  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    51.28800      0.53534      0.02723  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    29.69969      0.72667      0.06083  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     13.6350       0.8748      -0.0215  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     56.1548       0.5530      -0.0636  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    91.52717      0.28321     -0.02527

#fc1$dataset

## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_a","DOW") 
weight2 <- list.remove(fc2,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##      4.1771       1.0849      -0.1296  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    18.94484      0.87359     -0.05219  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    25.30640      0.73601      0.03736  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     9.76577      0.88114      0.03824  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##   10.815056     0.908693    -0.006085  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    32.52800      0.73212     -0.01506  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    64.35856      0.47981     -0.01355

#fc2$dataset

## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"GLWST","fc_add_mDOW","fc_hw_m","DOW") 
weight3 <- list.remove(fc3,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##      7.1011       1.0874      -0.1643  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    19.72180      0.87492     -0.06159  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    24.66845      0.73527      0.04454  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     9.95366      0.88047      0.03726  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   11.067785     0.909007    -0.008882  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    32.04112      0.73218     -0.01013  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   63.490702     0.479645    -0.005691

#fc3$dataset

Observations

• hotel GLWST: across the three model combinations, advanced booking models always have a larger weight than holt-winter method regardless of the days prior category or days of week

9.3.2 compare result errors from advance and combined models using training data

# by days prior category
cross_result_error("GLWST","days_prior_c")

## [[1]]
##   days_prior_c  MAE_add  MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a
## 1       1 to 7  9.28015 13.07666     7.795196           8.500324
## 2     15 to 21 15.94117 32.56143    12.610089          14.188762
## 3     22 to 28 16.92594 38.99523    13.395501          15.380978
## 4     29 to 60 18.35714 54.02179    13.785932          17.541774
## 5   60 or more 18.04491 83.25584    12.331291          17.069991
## 6      8 to 14 14.72105 26.58511    11.637384          13.007178
##   MAE_fc_add_fc_hw_m MAE_fc_add_mDOW_fc_hw_a
## 1           8.533622                 7.39985
## 2          14.237039                12.15145
## 3          15.457630                13.06441
## 4          17.515387                13.69863
## 5          17.046116                12.16209
## 6          13.027216                11.13242
## 
## [[2]]
##   days_prior_c  MAPE_add  MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1       1 to 7 0.1029720 0.1241249    0.08474013           0.1026526
## 2     15 to 21 0.1918225 0.3056005    0.14554752           0.1843609
## 3     22 to 28 0.2088548 0.3656297    0.15561768           0.2045567
## 4     29 to 60 0.2335163 0.4926554    0.16356515           0.2334446
## 5   60 or more 0.2065710 0.7359417    0.13698673           0.2059333
## 6      8 to 14 0.1697515 0.2480218    0.13146077           0.1652238
##   MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1           0.1030759               0.08735447
## 2           0.1850688               0.15062517
## 3           0.2056021               0.16327511
## 4           0.2332478               0.17110592
## 5           0.2056922               0.14180403
## 6           0.1653377               0.13640385

# by day of week
cross_result_error("GLWST","DOW")

## [[1]]
##   DOW  MAE_add  MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a MAE_fc_add_fc_hw_m
## 1 Sun 20.59738 52.16970     13.15957          17.097667          17.052245
## 2 Mon 16.42928 62.30680     14.20646          16.332925          16.327319
## 3 Tue 20.19633 76.27306     13.87837          17.145271          17.142709
## 4 Wed 18.21223 60.87822     12.71926          15.415175          15.407881
## 5 Thu 14.69321 51.86594     12.09776          14.652481          14.652644
## 6 Fri 14.15600 65.50156     10.91984          12.430955          12.433630
## 7 Sat 17.12483 82.95807     10.66083           8.897673           8.892612
##   MAE_fc_add_mDOW_fc_hw_a
## 1               13.110481
## 2               14.013861
## 3               13.824165
## 4               12.472228
## 5               11.984279
## 6               10.038697
## 7                8.201391
## 
## [[2]]
##   DOW  MAPE_add  MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 Sun 0.3071788 0.5248007    0.17113137          0.22522494
## 2 Mon 0.1839454 0.5995409    0.15389903          0.18746999
## 3 Tue 0.2311120 0.6657121    0.15296971          0.22912056
## 4 Wed 0.2150265 0.5322133    0.15892275          0.21288589
## 5 Thu 0.1979840 0.4882001    0.14989666          0.19745605
## 6 Fri 0.1507253 0.5703135    0.11136302          0.14238788
## 7 Sat 0.1544787 0.6719462    0.09951052          0.09829037
##   MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1          0.22483214               0.17000871
## 2          0.18741667               0.15720588
## 3          0.22913323               0.16943869
## 4          0.21283586               0.16324700
## 5          0.19743627               0.15391257
## 6          0.14245639               0.11088827
## 7          0.09826932               0.08752955

9.3.3 out-sample compare dataset

# by days prior category
G_outdata_dpr <-out_compare_dataset("GLWST","days_prior_c")
head(G_outdata_dpr)

##   hotel days_prior_c  stay_date    CONF_DT forecast_period month DOW
## 1 GLWST       1 to 7 2009-11-01 2009-10-31      1m_Nov_out    11 Sun
## 2 GLWST       1 to 7 2009-11-01 2009-10-31  3m_Nov-Jan_out    11 Sun
## 3 GLWST       1 to 7 2009-11-01 2009-10-31  6m_Nov-Apr_out    11 Sun
## 4 GLWST       1 to 7 2009-11-02 2009-10-31      1m_Nov_out    11 Mon
## 5 GLWST       1 to 7 2009-11-02 2009-10-31  3m_Nov-Jan_out    11 Mon
## 6 GLWST       1 to 7 2009-11-02 2009-10-31  6m_Nov-Apr_out    11 Mon
##   days_prior final_arrivals fc_naive fc_add_mDOW    fc_add    fc_mul
## 1          1             87       57       88.60  89.87978  89.12279
## 2          1             87       57       88.60  89.87978  89.12279
## 3          1             87       57       88.60  89.87978  89.12279
## 4          2            111       81      100.25 106.27687 106.93273
## 5          2            111       81      100.25 106.27687 106.93273
## 6          2            111       81      100.25 106.27687 106.93273
##     fc_hw_a  fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1  88.58456  90.4744       89.49435             88.8985
## 2  88.58456  90.4744       89.49435             88.8985
## 3  88.58456  90.4744       89.49435             88.8985
## 4 101.69017 102.9735      105.19834            100.3858
## 5 101.69017 102.9735      105.19834            100.3858
## 6 101.69017 102.9735      105.19834            100.3858
##   fc_add_mDOW.fc_hw_m
## 1            89.08029
## 2            89.08029
## 3            89.08029
## 4           100.51026
## 5           100.51026
## 6           100.51026

nrow(G_outdata_dpr)

## [1] 652

# by DOW
G_outdata_DOW <-out_compare_dataset("GLWST","DOW")
head(G_outdata_DOW)

##   hotel DOW  stay_date    CONF_DT forecast_period days_prior_c month
## 1 GLWST Fri 2009-11-06 2009-10-31  6m_Nov-Apr_out       1 to 7    11
## 2 GLWST Fri 2009-11-06 2009-10-31  3m_Nov-Jan_out       1 to 7    11
## 3 GLWST Fri 2010-02-26 2010-01-31      1m_Feb_out     22 to 28     2
## 4 GLWST Fri 2010-04-16 2010-03-31      1m_Apr_out     15 to 21     4
## 5 GLWST Fri 2010-01-01 2009-10-31  6m_Nov-Apr_out   60 or more     1
## 6 GLWST Fri 2009-12-04 2009-10-31  3m_Nov-Jan_out     29 to 60    12
##   days_prior final_arrivals fc_naive fc_add_mDOW    fc_add    fc_mul
## 1          6            125       80      132.50 135.04007 152.12844
## 2          6            125       80      132.50 135.04007 152.12844
## 3         26            100      114      117.25 105.76685 109.93741
## 4         16            105      127       91.75  94.40619  82.71067
## 5         62             66       59       89.20 107.30612 119.39269
## 6         34            125      118      120.50 140.31752 249.33076
##     fc_hw_a   fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1 111.94086 110.59625       123.7168           127.84771
## 2 111.94086 110.59625       123.7168           127.84771
## 3  82.54776  78.38306       109.3972           117.12564
## 4 123.74049 124.95882       100.4943            97.83606
## 5 111.92214 110.58524       108.3801            96.14718
## 6 111.92892 110.58817       126.6361           119.06245
##   fc_add_mDOW.fc_hw_m
## 1           127.93425
## 2           127.93425
## 3           117.09486
## 4            97.95257
## 5            96.23111
## 6           119.14821

nrow(G_outdata_DOW)

## [1] 652

9.3.4 out-sample result errors accross models

# by days prior category
out_crosss_result_error("GLWST","days_prior_c")

## [[1]]
## # A tibble: 11 x 8
## # Groups:   forecast_period [11]
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       17.9    21.9    49.3         17.3             22.1
##  2 3m_Nov-Jan_out       18.6    24.8    37.0         18.1             25.3
##  3 3m_Dec-Feb_out       16.9    22.7    37.3         15.8             24.9
##  4 3m_Jan-Mar_out       16.7    16.8    46.0         13.9             19.1
##  5 3m_Feb-Apr_out       21.0    14.5    40.1         14.7             15.0
##  6 1m_Nov_out           17.3    13.4    31.6         14.5             11.3
##  7 1m_Dec_out           21.4    15.4    25.2         13.4             17.2
##  8 1m_Jan_out           15.7    14.1    27.5         11.9             19.9
##  9 1m_Feb_out           13.2    11.4    24.1         11.3             10.9
## 10 1m_Mar_out           26.9    12.5    25.3         11.1             12.4
## 11 1m_Apr_out           22.2    13.1    34.7         10.5             12.4
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[2]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     0.374    0.520         0.269            0.393
##  2 3m_Nov-Jan_out     0.478    0.428         0.317            0.505
##  3 3m_Dec-Feb_out     0.440    0.476         0.278            0.494
##  4 3m_Jan-Mar_out     0.243    0.548         0.193            0.300
##  5 3m_Feb-Apr_out     0.178    0.436         0.183            0.184
##  6 1m_Nov_out         0.138    0.301         0.139            0.119
##  7 1m_Dec_out         0.378    0.337         0.281            0.442
##  8 1m_Jan_out         0.271    0.418         0.192            0.396
##  9 1m_Feb_out         0.137    0.263         0.133            0.129
## 10 1m_Mar_out         0.133    0.274         0.128            0.135
## 11 1m_Apr_out         0.143    0.387         0.116            0.150
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAPE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[3]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.22     2.76          0.966            1.24 
##  2 3m_Nov-Jan_out     1.33     1.98          0.973            1.36 
##  3 3m_Dec-Feb_out     1.34     2.21          0.934            1.47 
##  4 3m_Jan-Mar_out     1.01     2.76          0.837            1.15 
##  5 3m_Feb-Apr_out     0.689    1.91          0.696            0.711
##  6 1m_Nov_out         0.774    1.82          0.838            0.652
##  7 1m_Dec_out         0.717    1.18          0.625            0.801
##  8 1m_Jan_out         0.894    1.75          0.757            1.26 
##  9 1m_Feb_out         0.861    1.82          0.853            0.825
## 10 1m_Mar_out         0.463    0.938         0.414            0.459
## 11 1m_Apr_out         0.588    1.56          0.474            0.557
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MASE_fc_add_mDOW.fc_hw_m <dbl>

# by DOW 
out_crosss_result_error("GLWST","DOW")

## [[1]]
## # A tibble: 11 x 8
## # Groups:   forecast_period [11]
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       17.9    21.9    49.3         17.3            20.7 
##  2 3m_Nov-Jan_out       18.6    24.8    37.0         18.1            23.4 
##  3 3m_Dec-Feb_out       16.9    22.7    37.3         15.8            24.1 
##  4 3m_Jan-Mar_out       16.7    16.8    46.0         13.9            18.7 
##  5 3m_Feb-Apr_out       21.0    14.5    40.1         14.7            14.1 
##  6 1m_Nov_out           17.3    13.4    31.6         14.5             9.71
##  7 1m_Dec_out           21.4    15.4    25.2         13.4            17.9 
##  8 1m_Jan_out           15.7    14.1    27.5         11.9            20.8 
##  9 1m_Feb_out           13.2    11.4    24.1         11.3            12.8 
## 10 1m_Mar_out           26.9    12.5    25.3         11.1            10.9 
## 11 1m_Apr_out           22.2    13.1    34.7         10.5            11.9 
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[2]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     0.374    0.520         0.269           0.368 
##  2 3m_Nov-Jan_out     0.478    0.428         0.317           0.475 
##  3 3m_Dec-Feb_out     0.440    0.476         0.278           0.480 
##  4 3m_Jan-Mar_out     0.243    0.548         0.193           0.291 
##  5 3m_Feb-Apr_out     0.178    0.436         0.183           0.177 
##  6 1m_Nov_out         0.138    0.301         0.139           0.0998
##  7 1m_Dec_out         0.378    0.337         0.281           0.453 
##  8 1m_Jan_out         0.271    0.418         0.192           0.417 
##  9 1m_Feb_out         0.137    0.263         0.133           0.160 
## 10 1m_Mar_out         0.133    0.274         0.128           0.119 
## 11 1m_Apr_out         0.143    0.387         0.116           0.130 
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAPE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[3]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.22     2.76          0.966            1.16 
##  2 3m_Nov-Jan_out     1.33     1.98          0.973            1.25 
##  3 3m_Dec-Feb_out     1.34     2.21          0.934            1.43 
##  4 3m_Jan-Mar_out     1.01     2.76          0.837            1.12 
##  5 3m_Feb-Apr_out     0.689    1.91          0.696            0.671
##  6 1m_Nov_out         0.774    1.82          0.838            0.560
##  7 1m_Dec_out         0.717    1.18          0.625            0.836
##  8 1m_Jan_out         0.894    1.75          0.757            1.32 
##  9 1m_Feb_out         0.861    1.82          0.853            0.963
## 10 1m_Mar_out         0.463    0.938         0.414            0.404
## 11 1m_Apr_out         0.588    1.56          0.474            0.535
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MASE_fc_add_mDOW.fc_hw_m <dbl>

Observations

• combined model perform better using the DOW bucket than using the days prior bucket for hotel GLWST, and it outperform the additive model based on month and days of week 5 out of 9. Both models are more accurate than the naive forecast.
• among the combined model, the advanced booking model additive method based on month and day of week & holt-winter multiplicative method combined model has an overall lowest MASE value.

9.4.1 try different combinations of models and fit weight for each combined model using regression

# by days prior category
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add","fc_hw_a","days_prior_c") 
weight1 <- list.remove(fc1,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -26.8037       1.0524       0.2365  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -60.3307       1.1622       0.4984  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -71.3959       1.2464       0.5455  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -80.1914       1.3254       0.5717  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     -93.468        1.421        0.631  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -98.5864       1.6318       0.4851

#fc1$dataset

## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_a","days_prior_c") 
weight2 <- list.remove(fc2,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -3.86612      1.00690      0.04047  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -5.40022      1.03469      0.03958  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##   -4.219190     1.065780     0.001625  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     -4.4631       1.0662       0.0102  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -2.52781      1.02414      0.05253  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     7.30964      1.06686     -0.06671

#fc3$dataset

## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_m","days_prior_c") 
weight3 <- list.remove(fc3,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##      -3.371        1.016        0.026  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     -5.1735       1.0382       0.0333  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   -4.299010     1.063210     0.004978  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    -3.99409      1.08042     -0.00899  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    -2.15161      1.01960      0.05127  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     6.06617      1.04369     -0.02579

#fc4$dataset


# by DOW
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add","fc_hw_a","DOW") 
weight1 <- list.remove(fc1,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##  -33.805386     0.923631     0.004683  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##   -28.82048      1.51540      0.02644  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    55.83555      0.76447      0.09117  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     57.4416       0.6702       0.1365  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##   -53.13372      1.56247      0.02914  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##   -66.11939      1.41989     -0.05311  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##   -40.19102      1.44238     -0.05679

#fc1$dataset

## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_a","DOW") 
weight2 <- list.remove(fc2,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -4.83220      1.14074      0.03263  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -5.04598      1.07855      0.01967  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -0.47192      0.97195      0.06897  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     2.58293      0.93608      0.08636  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -1.46285      1.07546     -0.01857  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##   -20.78237      1.41731      0.02061  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##   -21.90091      1.26506      0.03861

#fc2$dataset

## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"MLKEP","fc_add_mDOW","fc_hw_m","DOW") 
weight3 <- list.remove(fc3,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     -7.5710       1.1379       0.1023  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     -7.9545       1.0787       0.0446  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     0.02970      0.97664      0.05706  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     4.49191      0.94708      0.05639  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   -3.892182     1.072141     0.009532  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   -22.14399      1.41784      0.04569  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   -19.73525      1.26638      0.01073

#fc3$dataset

Observations

• hotel WARUK: across the three model combinations, advanced booking models always have a larger weight than holt-winter method regardless of the days prior category or the Day of Week `

9.4.2 compare result errors from advance and combined models using training data

# by days prior category
cross_result_error("MLKEP","days_prior_c")

## [[1]]
##   days_prior_c  MAE_add  MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a
## 1       1 to 7 15.71757 13.38203      8.97154           12.12138
## 2     15 to 21 35.85519 43.70532     17.69533           26.18290
## 3     22 to 28 37.77129 53.21220     18.70008           27.78223
## 4     29 to 60 40.03824 74.12069     20.21390           29.41933
## 5   60 or more 41.81673 97.18865     19.82303           33.45193
## 6      8 to 14 31.71407 31.76389     15.91995           22.00902
##   MAE_fc_add_fc_hw_m MAE_fc_add_mDOW_fc_hw_a
## 1           12.35358                8.888232
## 2           27.85207               17.313990
## 3           29.93570               18.371426
## 4           30.48810               19.527330
## 5           34.26935               20.048303
## 6           23.18296               15.562555
## 
## [[2]]
##   days_prior_c  MAPE_add  MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1       1 to 7 0.2538294 0.1462345     0.1261150           0.1750052
## 2     15 to 21 0.5779082 0.4482276     0.2578506           0.4071492
## 3     22 to 28 0.6032598 0.5421447     0.2688598           0.4367779
## 4     29 to 60 0.6077286 0.7128861     0.2743003           0.4606706
## 5   60 or more 0.5934720 0.7844658     0.2240510           0.5445456
## 6      8 to 14 0.5093517 0.3311312     0.2295127           0.3283251
##   MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1           0.1731570                0.1229065
## 2           0.4212440                0.2571184
## 3           0.4610295                0.2713249
## 4           0.4658615                0.2822222
## 5           0.5558918                0.2526111
## 6           0.3311637                0.2268515

# by day of week
cross_result_error("MLKEP","DOW")

## [[1]]
##   DOW  MAE_add  MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a MAE_fc_add_fc_hw_m
## 1 Sun 40.94712 32.44107     10.32042           18.05952           18.04410
## 2 Mon 35.54116 74.01959     20.94503           25.56145           25.59021
## 3 Tue 51.18409 77.93646     20.49541           25.69584           25.76140
## 4 Wed 47.87701 92.37488     20.59539           25.17492           25.27315
## 5 Thu 26.50744 58.35156     19.93605           25.66179           25.66932
## 6 Fri 35.77928 62.98778     14.43518           21.66939           21.67287
## 7 Sat 28.38036 97.25092     21.83446           26.92492           26.90461
##   MAE_fc_add_mDOW_fc_hw_a
## 1                10.76672
## 2                20.96791
## 3                19.90494
## 4                19.95781
## 5                19.63722
## 6                13.75150
## 7                20.67573
## 
## [[2]]
##   DOW  MAPE_add  MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 Sun 1.3337987 0.5686062     0.2380349           0.5068201
## 2 Mon 0.3567670 0.5837443     0.2435203           0.3356350
## 3 Tue 0.4262173 0.5580133     0.2436829           0.3583691
## 4 Wed 0.3427439 0.6571530     0.1812571           0.2471375
## 5 Thu 0.5149395 0.5892349     0.3413117           0.5185825
## 6 Fri 0.7651258 0.7159496     0.1915158           0.3862642
## 7 Sat 0.3539726 0.7632572     0.2289642           0.3306549
##   MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1           0.5055928                0.2568672
## 2           0.3356333                0.2556876
## 3           0.3581649                0.2531758
## 4           0.2485948                0.1854063
## 5           0.5185126                0.3524013
## 6           0.3859837                0.2164356
## 7           0.3302099                0.2351247

9.4.3 out-sample compare dataset

# by days prior category
head(out_compare_dataset("MLKEP","days_prior_c"))

##   hotel days_prior_c  stay_date    CONF_DT forecast_period month DOW
## 1 MLKEP       1 to 7 2009-11-01 2009-10-31      1m_Nov_out    11 Sun
## 2 MLKEP       1 to 7 2009-11-01 2009-10-31  3m_Nov-Jan_out    11 Sun
## 3 MLKEP       1 to 7 2009-11-01 2009-10-31  6m_Nov-Apr_out    11 Sun
## 4 MLKEP       1 to 7 2009-11-02 2009-10-31      1m_Nov_out    11 Mon
## 5 MLKEP       1 to 7 2009-11-02 2009-10-31  3m_Nov-Jan_out    11 Mon
## 6 MLKEP       1 to 7 2009-11-02 2009-10-31  6m_Nov-Apr_out    11 Mon
##   days_prior final_arrivals fc_naive fc_add_mDOW   fc_add   fc_mul
## 1          1             31       47        35.8 40.76685 34.12768
## 2          1             31       47        35.8 40.76685 34.12768
## 3          1             31       47        35.8 40.76685 34.12768
## 4          2             90      159        99.5 91.38434 90.93525
## 5          2             90      159        99.5 91.38434 90.93525
## 6          2             90      159        99.5 91.38434 90.93525
##     fc_hw_a  fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1  9.680091 27.15421       18.39077            32.57252
## 2  9.680091 27.15421       18.39077            32.57252
## 3  9.680091 27.15421       18.39077            32.57252
## 4 76.327811 61.08958       87.42660            99.40906
## 5 76.327811 61.08958       87.42660            99.40906
## 6 76.327811 61.08958       87.42660            99.40906
##   fc_add_mDOW.fc_hw_m
## 1            33.71037
## 2            33.71037
## 3            33.71037
## 4            99.31636
## 5            99.31636
## 6            99.31636

# by DOW
head(out_compare_dataset("MLKEP","DOW"))

##   hotel DOW  stay_date    CONF_DT forecast_period days_prior_c month
## 1 MLKEP Fri 2010-03-12 2009-10-31  6m_Nov-Apr_out   60 or more     3
## 2 MLKEP Fri 2009-11-20 2009-10-31  3m_Nov-Jan_out     15 to 21    11
## 3 MLKEP Fri 2010-03-05 2009-12-31  3m_Jan-Mar_out   60 or more     3
## 4 MLKEP Fri 2009-11-06 2009-10-31  6m_Nov-Apr_out       1 to 7    11
## 5 MLKEP Fri 2010-01-15 2009-12-31      1m_Jan_out     15 to 21     1
## 6 MLKEP Fri 2009-11-20 2009-10-31      1m_Nov_out     15 to 21    11
##   days_prior final_arrivals fc_naive fc_add_mDOW   fc_add   fc_mul
## 1        132             28       54    50.00000 99.81579 30.11797
## 2         20             61       36    45.50000 82.97258 42.14541
## 3         64             42       50    58.33333 95.28125 35.37522
## 4          6             39       38    39.50000 57.90893 29.19774
## 5         15             32       41    29.00000 75.21168 25.16342
## 6         20             61       36    45.50000 82.97258 42.14541
##     fc_hw_a  fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a
## 1  24.11947 32.63922       74.32751            50.58052
## 2  24.30545 33.85222       50.40206            44.20644
## 3 -16.47771 20.74020       70.04504            61.55458
## 4  24.37548 34.29604       14.81060            35.70400
## 5 -16.14890 20.90702       41.53091            19.98682
## 6  24.30545 33.85222       50.40206            44.20644
##   fc_add_mDOW.fc_hw_m
## 1            50.23946
## 2            43.91459
## 3            61.51113
## 4            35.42782
## 5            19.92871
## 6            43.91459

9.4.4 out-sample result errors accross models

# by days prior category
out_crosss_result_error("MLKEP","days_prior_c")

## [[1]]
## # A tibble: 11 x 8
## # Groups:   forecast_period [11]
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       19.9    42.9    51.2        25.0              35.7
##  2 3m_Nov-Jan_out       19.6    44.3    52.7        25.3              37.6
##  3 3m_Dec-Feb_out       19.2    40.5    48.8        26.3              35.0
##  4 3m_Jan-Mar_out       16.2    39.6    58.5        18.1              43.3
##  5 3m_Feb-Apr_out       16.2    37.9    62.5        14.9              25.6
##  6 1m_Nov_out           20.7    37.0    38.4        14.0              34.9
##  7 1m_Dec_out           20.2    35.6    26.5        29.2              34.9
##  8 1m_Jan_out           16.7    39.1    40.9        20.3              42.3
##  9 1m_Feb_out           13.8    31.3    33.6         9.83             18.0
## 10 1m_Mar_out           17.1    31.4    35.3        13.5              19.1
## 11 1m_Apr_out           24      34.3    34.3        12.9              22.4
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[2]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     0.741    0.652         0.439            0.556
##  2 3m_Nov-Jan_out     0.761    0.680         0.458            0.582
##  3 3m_Dec-Feb_out     0.783    0.571         0.503            0.814
##  4 3m_Jan-Mar_out     0.597    0.510         0.229            0.443
##  5 3m_Feb-Apr_out     0.533    0.610         0.194            0.343
##  6 1m_Nov_out         0.371    0.334         0.126            0.291
##  7 1m_Dec_out         0.765    0.442         0.679            0.888
##  8 1m_Jan_out         0.746    0.365         0.295            0.510
##  9 1m_Feb_out         0.406    0.344         0.114            0.198
## 10 1m_Mar_out         0.388    0.358         0.159            0.215
## 11 1m_Apr_out         0.433    0.368         0.156            0.222
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAPE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[3]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out      2.16     2.58         1.26             1.80 
##  2 3m_Nov-Jan_out      2.25     2.68         1.29             1.91 
##  3 3m_Dec-Feb_out      2.11     2.54         1.37             1.82 
##  4 3m_Jan-Mar_out      2.44     3.61         1.12             2.67 
##  5 3m_Feb-Apr_out      2.34     3.86         0.922            1.58 
##  6 1m_Nov_out          1.79     1.86         0.678            1.69 
##  7 1m_Dec_out          1.76     1.31         1.45             1.73 
##  8 1m_Jan_out          2.35     2.45         1.22             2.54 
##  9 1m_Feb_out          2.27     2.44         0.715            1.31 
## 10 1m_Mar_out          1.83     2.06         0.786            1.11 
## 11 1m_Apr_out          1.43     1.43         0.537            0.935
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MASE_fc_add_mDOW.fc_hw_m <dbl>

# by DOW 
out_crosss_result_error("MLKEP","DOW")

## [[1]]
## # A tibble: 11 x 8
## # Groups:   forecast_period [11]
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       19.9    42.9    51.2        25.0              30.1
##  2 3m_Nov-Jan_out       19.6    44.3    52.7        25.3              31.1
##  3 3m_Dec-Feb_out       19.2    40.5    48.8        26.3              27.5
##  4 3m_Jan-Mar_out       16.2    39.6    58.5        18.1              21.2
##  5 3m_Feb-Apr_out       16.2    37.9    62.5        14.9              19.0
##  6 1m_Nov_out           20.7    37.0    38.4        14.0              25.0
##  7 1m_Dec_out           20.2    35.6    26.5        29.2              33.0
##  8 1m_Jan_out           16.7    39.1    40.9        20.3              25.3
##  9 1m_Feb_out           13.8    31.3    33.6         9.83             14.5
## 10 1m_Mar_out           17.1    31.4    35.3        13.5              15.4
## 11 1m_Apr_out           24      34.3    34.3        12.9              16.1
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[2]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     0.741    0.652         0.439            0.581
##  2 3m_Nov-Jan_out     0.761    0.680         0.458            0.615
##  3 3m_Dec-Feb_out     0.783    0.571         0.503            0.600
##  4 3m_Jan-Mar_out     0.597    0.510         0.229            0.290
##  5 3m_Feb-Apr_out     0.533    0.610         0.194            0.260
##  6 1m_Nov_out         0.371    0.334         0.126            0.263
##  7 1m_Dec_out         0.765    0.442         0.679            0.835
##  8 1m_Jan_out         0.746    0.365         0.295            0.401
##  9 1m_Feb_out         0.406    0.344         0.114            0.182
## 10 1m_Mar_out         0.388    0.358         0.159            0.157
## 11 1m_Apr_out         0.433    0.368         0.156            0.199
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAPE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[3]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out      2.16     2.58         1.26             1.51 
##  2 3m_Nov-Jan_out      2.25     2.68         1.29             1.58 
##  3 3m_Dec-Feb_out      2.11     2.54         1.37             1.43 
##  4 3m_Jan-Mar_out      2.44     3.61         1.12             1.31 
##  5 3m_Feb-Apr_out      2.34     3.86         0.922            1.17 
##  6 1m_Nov_out          1.79     1.86         0.678            1.21 
##  7 1m_Dec_out          1.76     1.31         1.45             1.63 
##  8 1m_Jan_out          2.35     2.45         1.22             1.52 
##  9 1m_Feb_out          2.27     2.44         0.715            1.06 
## 10 1m_Mar_out          1.83     2.06         0.786            0.897
## 11 1m_Apr_out          1.43     1.43         0.537            0.671
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MASE_fc_add_mDOW.fc_hw_m <dbl>

Observations

• among the combined model, the advanced booking model additive method based on month and day of week & holt-winter multiplicative method combined model has an overall lowest MASE value.
• compare to the advanced booking model additive method based on month and day of week, the advanced booking model additive method based on month and day of week & holt-winter multiplicative method combined model yields slightly better result when forecast 1month November, January and April. However, both model outperform naive forecast 5 out of 9 times.

9.5.1 try different combinations of models and fit weight for each combined model using regression

# by days prior category
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add","fc_hw_a","days_prior_c") 
weight1 <- list.remove(fc1,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -22.8319       0.9506       0.3311  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -34.6808       0.8502       0.5782  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -34.3787       0.7792       0.6454  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -37.8344       0.8215       0.6422  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -52.0378       1.0076       0.6167  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##   -107.5397       1.7011       0.5165

#fc1$dataset

## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_a","days_prior_c") 
weight2 <- list.remove(fc2,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     0.04751      0.94525      0.05878  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     0.96580      0.96209      0.03626  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     0.75930      0.98336      0.01964  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     0.29110      0.97964      0.02822  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -1.05465      0.95042      0.06938  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -2.53707      0.97653      0.04308

#fc3$dataset

## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_m","days_prior_c") 
weight3 <- list.remove(fc3,c("dataset")) %>% print()

## $`1 to 7`
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     0.21389      0.95382      0.04824  
## 
## 
## $`8 to 14`
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     0.39948      0.95698      0.04827  
## 
## 
## $`15 to 21`
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    1.281093     1.000511    -0.003414  
## 
## 
## $`22 to 28`
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    0.967731     1.002085    -0.001906  
## 
## 
## $`29 to 60`
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    -0.14226      0.98904      0.02124  
## 
## 
## $`60 or more`
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    -1.57458      0.99777      0.01093

#fc4$dataset


# by DOW
## fc_add and fc_hw_a
fc1<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add","fc_hw_a","DOW") 
weight1 <- list.remove(fc1,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     -0.4003       0.4076       0.1012  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    13.62147      0.84378      0.02152  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    42.97060      0.70586      0.06587  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     43.2786       0.5672       0.1176  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##    -5.45833      0.92625      0.06893  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##     -63.590        1.627       -0.104  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)       fc_add      fc_hw_a  
##      -1.988        1.240       -0.155

#fc1$dataset

## fc_add_mDOW and fc_hw_a
fc2<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_a","DOW") 
weight2 <- list.remove(fc2,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -1.54439      0.98181      0.04492  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -8.25075      1.03222      0.05683  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##    -4.99754      0.97041      0.07663  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     -9.9731       0.9733       0.1113  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     -2.5312       0.9194       0.1108  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     0.48448      0.99337     -0.01639  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_a  
##     6.49266      0.96818     -0.02488

#fc2$dataset

## fc_add_mDOW and fc_hw_mul
fc3<- fc_combined_weight(in_compare_dataset,"WARUK","fc_add_mDOW","fc_hw_m","DOW") 
weight3 <- list.remove(fc3,c("dataset")) %>% print()

## $Sun
## 
## Call:
## lm(formula = formula, data = hotel_dataset1)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    -1.30391      0.99359      0.02321  
## 
## 
## $Mon
## 
## Call:
## lm(formula = formula, data = hotel_dataset2)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   -2.916057     1.030373    -0.005092  
## 
## 
## $Tue
## 
## Call:
## lm(formula = formula, data = hotel_dataset3)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   3.2000731    0.9733635    0.0005902  
## 
## 
## $Wed
## 
## Call:
## lm(formula = formula, data = hotel_dataset4)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    -0.47276      0.98094      0.01915  
## 
## 
## $Thu
## 
## Call:
## lm(formula = formula, data = hotel_dataset5)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##     4.03645      0.92153      0.02564  
## 
## 
## $Fri
## 
## Call:
## lm(formula = formula, data = hotel_dataset6)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##   -1.144454     0.993038     0.009081  
## 
## 
## $Sat
## 
## Call:
## lm(formula = formula, data = hotel_dataset7)
## 
## Coefficients:
## (Intercept)  fc_add_mDOW      fc_hw_m  
##    3.522440     0.967765     0.006172

#fc3$dataset

` ### compare result errors from advance and combined models using training data

# by days prior category
cross_result_error("WARUK","days_prior_c")

## [[1]]
##   days_prior_c  MAE_add  MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a
## 1       1 to 7 13.16747 13.78440     8.470605           10.91619
## 2     15 to 21 26.17872 37.37894    13.496697           19.67645
## 3     22 to 28 27.50415 42.70794    14.236632           20.89803
## 4     29 to 60 28.22480 50.34067    14.949365           21.52320
## 5   60 or more 28.35742 44.87594    13.120235           23.28486
## 6      8 to 14 23.19617 29.14020    12.445378           17.66167
##   MAE_fc_add_fc_hw_m MAE_fc_add_mDOW_fc_hw_a
## 1           11.19652                8.429701
## 2           21.07948               13.483197
## 3           22.67395               14.222271
## 4           24.64998               14.849603
## 5           26.22888               13.129507
## 6           18.41534               12.439229
## 
## [[2]]
##   days_prior_c  MAPE_add  MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1       1 to 7 0.2587100 0.1678449     0.1333314           0.1890131
## 2     15 to 21 0.5089602 0.4503076     0.2100129           0.3382934
## 3     22 to 28 0.5368596 0.5170701     0.2208814           0.3650624
## 4     29 to 60 0.5508472 0.5995817     0.2306938           0.3768414
## 5   60 or more 0.5348635 0.5317925     0.1950102           0.3862016
## 6      8 to 14 0.4625152 0.3514595     0.2042149           0.3160088
##   MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1           0.1939150                0.1380430
## 2           0.3787438                0.2140657
## 3           0.4188758                0.2245825
## 4           0.4605326                0.2323704
## 5           0.4648628                0.1922066
## 6           0.3327093                0.2099423

# by day of week
cross_result_error("WARUK","DOW")

## [[1]]
##   DOW  MAE_add  MAE_mul MAE_add_mDOW MAE_fc_add_fc_hw_a MAE_fc_add_fc_hw_m
## 1 Sun 45.06411 17.35045     8.395196           11.49850           11.37448
## 2 Mon 20.25517 34.96238    16.023921           20.29259           20.28799
## 3 Tue 29.53430 54.29384    14.300678           18.28677           18.32942
## 4 Wed 23.92818 52.25561    13.931884           17.25048           17.33644
## 5 Thu 19.28235 31.42635    13.950200           18.28369           18.34782
## 6 Fri 26.76339 43.46796    12.618289           19.61610           19.60954
## 7 Sat 25.31154 67.69345    13.433780           24.85638           24.83832
##   MAE_fc_add_mDOW_fc_hw_a
## 1                 8.40671
## 2                15.97440
## 3                14.22321
## 4                13.79342
## 5                13.83609
## 6                12.59668
## 7                13.45303
## 
## [[2]]
##   DOW  MAPE_add  MAPE_mul MAPE_add_mDOW MAPE_fc_add_fc_hw_a
## 1 Sun 1.6701665 0.4929499     0.2700668           0.3904811
## 2 Mon 0.2789003 0.4032735     0.2310543           0.2900457
## 3 Tue 0.2961594 0.5158522     0.1775399           0.2453709
## 4 Wed 0.2363424 0.5204803     0.1563924           0.2072590
## 5 Thu 0.3154169 0.4342376     0.2137521           0.2799274
## 6 Fri 0.5499524 0.5872966     0.1947371           0.3439894
## 7 Sat 0.3383350 0.6546574     0.1688589           0.3471894
##   MAPE_fc_add_fc_hw_m MAPE_fc_add_mDOW_fc_hw_a
## 1           0.3893193                0.2665331
## 2           0.2898848                0.2272126
## 3           0.2453085                0.1786934
## 4           0.2082605                0.1543252
## 5           0.2808418                0.2132284
## 6           0.3433573                0.1921644
## 7           0.3459637                0.1746703

9.5.2 out-sample compare dataset

# by days prior category
head(out_compare_dataset("WARUK","days_prior_c"))

##   hotel days_prior_c  stay_date    CONF_DT forecast_period month DOW
## 1 WARUK       1 to 7 2009-11-01 2009-10-31      1m_Nov_out    11 Sun
## 2 WARUK       1 to 7 2009-11-01 2009-10-31  3m_Nov-Jan_out    11 Sun
## 3 WARUK       1 to 7 2009-11-01 2009-10-31  6m_Nov-Apr_out    11 Sun
## 4 WARUK       1 to 7 2009-11-02 2009-10-31      1m_Nov_out    11 Mon
## 5 WARUK       1 to 7 2009-11-02 2009-10-31  3m_Nov-Jan_out    11 Mon
## 6 WARUK       1 to 7 2009-11-02 2009-10-31  6m_Nov-Apr_out    11 Mon
##   days_prior final_arrivals fc_naive fc_add_mDOW   fc_add   fc_mul
## 1          1             29       41        20.8 28.70674 20.09441
## 2          1             29       41        20.8 28.70674 20.09441
## 3          1             29       41        20.8 28.70674 20.09441
## 4          2             67      137        65.0 49.68488 39.81006
## 5          2             67      137        65.0 49.68488 39.81006
## 6          2             67      137        65.0 49.68488 39.81006
##    fc_hw_a  fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a fc_add_mDOW.fc_hw_m
## 1 24.12845 33.44387       12.44587            21.12701            21.66665
## 2 24.12845 33.44387       12.44587            21.12701            21.66665
## 3 24.12845 33.44387       12.44587            21.12701            21.66665
## 4 60.87769 68.32838       44.55549            65.06727            65.50839
## 5 60.87769 68.32838       44.55549            65.06727            65.50839
## 6 60.87769 68.32838       44.55549            65.06727            65.50839

# by DOW
head(out_compare_dataset("WARUK","DOW"))

##   hotel DOW  stay_date    CONF_DT forecast_period days_prior_c month
## 1 WARUK Fri 2010-01-29 2009-10-31  6m_Nov-Apr_out   60 or more     1
## 2 WARUK Fri 2009-12-11 2009-11-30  3m_Dec-Feb_out      8 to 14    12
## 3 WARUK Fri 2010-02-12 2010-01-31  3m_Feb-Apr_out      8 to 14     2
## 4 WARUK Fri 2010-01-29 2009-10-31  3m_Nov-Jan_out   60 or more     1
## 5 WARUK Fri 2009-12-18 2009-11-30  3m_Dec-Feb_out     15 to 21    12
## 6 WARUK Fri 2010-01-01 2009-12-31  3m_Jan-Mar_out       1 to 7     1
##   days_prior final_arrivals fc_naive fc_add_mDOW   fc_add    fc_mul
## 1         90             26       25       27.00 83.26682  22.32962
## 2         11             64       62       64.25 91.00182 106.81377
## 3         12             29       40       36.25 63.58652  29.10090
## 4         90             26       25       27.00 83.26682  22.32962
## 5         18             51       54       59.25 74.15596  48.89513
## 6          1             20       34       21.40 26.70674  17.73036
##    fc_hw_a  fc_hw_m fc_add.fc_hw_a fc_add_mDOW.fc_hw_a fc_add_mDOW.fc_hw_m
## 1 57.69939 62.20178       65.87560            26.35978            26.23245
## 2 51.62973 50.53287       79.09134            63.46227            63.11716
## 3 38.02932 33.57421       35.90379            35.87083            35.15808
## 4 57.69939 62.20178       65.87560            26.35978            26.23245
## 5 51.62913 50.56414       51.68451            58.49543            58.15225
## 6 19.89827 34.24062      -22.21035            21.41646            20.41751

9.5.3 out-sample result errors accross models

# by days prior category
out_crosss_result_error("WARUK","days_prior_c")

## [[1]]
## # A tibble: 11 x 8
## # Groups:   forecast_period [11]
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       22.3    32.8    33.3        18.0              24.4
##  2 3m_Nov-Jan_out       24.1    34.5    29.9        18.0              24.6
##  3 3m_Dec-Feb_out       19.8    32.0    32.4        16.6              23.2
##  4 3m_Jan-Mar_out       15.8    26.3    39.0        14.0              22.8
##  5 3m_Feb-Apr_out       17.9    22.3    32.0        16.3              16.6
##  6 1m_Nov_out           26.9    26.9    28.5        15.0              21.0
##  7 1m_Dec_out           26.3    28.4    23.4        18.9              22.8
##  8 1m_Jan_out           17.3    27.8    28.9         9.07             18.0
##  9 1m_Feb_out           13.2    20.8    22.8        14.0              15.5
## 10 1m_Mar_out           17.9    19.9    25.5        12.5              12.9
## 11 1m_Apr_out           31.5    22.3    27.6        17.3              13.4
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[2]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.05     0.537         0.461            0.669
##  2 3m_Nov-Jan_out     1.20     0.548         0.515            0.757
##  3 3m_Dec-Feb_out     1.14     0.606         0.505            0.787
##  4 3m_Jan-Mar_out     0.738    0.565         0.266            0.333
##  5 3m_Feb-Apr_out     0.500    0.432         0.250            0.268
##  6 1m_Nov_out         0.668    0.437         0.304            0.413
##  7 1m_Dec_out         1.14     0.586         0.713            0.916
##  8 1m_Jan_out         0.959    0.515         0.257            0.340
##  9 1m_Feb_out         0.494    0.326         0.237            0.268
## 10 1m_Mar_out         0.431    0.346         0.190            0.219
## 11 1m_Apr_out         0.720    0.408         0.446            0.410
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAPE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[3]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.47     1.49          0.806            1.09 
##  2 3m_Nov-Jan_out     1.43     1.24          0.749            1.02 
##  3 3m_Dec-Feb_out     1.61     1.63          0.836            1.17 
##  4 3m_Jan-Mar_out     1.67     2.48          0.890            1.45 
##  5 3m_Feb-Apr_out     1.25     1.79          0.909            0.926
##  6 1m_Nov_out         1.00     1.06          0.558            0.782
##  7 1m_Dec_out         1.08     0.889         0.719            0.866
##  8 1m_Jan_out         1.60     1.67          0.524            1.04 
##  9 1m_Feb_out         1.58     1.73          1.06             1.18 
## 10 1m_Mar_out         1.11     1.42          0.699            0.717
## 11 1m_Apr_out         0.708    0.875         0.549            0.426
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MASE_fc_add_mDOW.fc_hw_m <dbl>

# by DOW 
out_crosss_result_error("WARUK","DOW")

## [[1]]
## # A tibble: 11 x 8
## # Groups:   forecast_period [11]
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_fc_add.fc_h…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       22.3    32.8    33.3        18.0              21.2
##  2 3m_Nov-Jan_out       24.1    34.5    29.9        18.0              21.8
##  3 3m_Dec-Feb_out       19.8    32.0    32.4        16.6              23.0
##  4 3m_Jan-Mar_out       15.8    26.3    39.0        14.0              16.4
##  5 3m_Feb-Apr_out       17.9    22.3    32.0        16.3              14.5
##  6 1m_Nov_out           26.9    26.9    28.5        15.0              11.9
##  7 1m_Dec_out           26.3    28.4    23.4        18.9              24.7
##  8 1m_Jan_out           17.3    27.8    28.9         9.07             15.1
##  9 1m_Feb_out           13.2    20.8    22.8        14.0              13.6
## 10 1m_Mar_out           17.9    19.9    25.5        12.5              13.6
## 11 1m_Apr_out           31.5    22.3    27.6        17.3              14.5
## # … with 2 more variables: MAE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[2]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.05     0.537         0.461            0.636
##  2 3m_Nov-Jan_out     1.20     0.548         0.515            0.721
##  3 3m_Dec-Feb_out     1.14     0.606         0.505            0.769
##  4 3m_Jan-Mar_out     0.738    0.565         0.266            0.380
##  5 3m_Feb-Apr_out     0.500    0.432         0.250            0.241
##  6 1m_Nov_out         0.668    0.437         0.304            0.264
##  7 1m_Dec_out         1.14     0.586         0.713            0.980
##  8 1m_Jan_out         0.959    0.515         0.257            0.476
##  9 1m_Feb_out         0.494    0.326         0.237            0.233
## 10 1m_Mar_out         0.431    0.346         0.190            0.217
## 11 1m_Apr_out         0.720    0.408         0.446            0.462
## # … with 2 more variables: MAPE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MAPE_fc_add_mDOW.fc_hw_m <dbl>
## 
## [[3]]
## # A tibble: 11 x 7
## # Groups:   forecast_period [11]
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_fc_add.fc_…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.47     1.49          0.806            0.950
##  2 3m_Nov-Jan_out     1.43     1.24          0.749            0.905
##  3 3m_Dec-Feb_out     1.61     1.63          0.836            1.16 
##  4 3m_Jan-Mar_out     1.67     2.48          0.890            1.04 
##  5 3m_Feb-Apr_out     1.25     1.79          0.909            0.812
##  6 1m_Nov_out         1.00     1.06          0.558            0.444
##  7 1m_Dec_out         1.08     0.889         0.719            0.938
##  8 1m_Jan_out         1.60     1.67          0.524            0.870
##  9 1m_Feb_out         1.58     1.73          1.06             1.03 
## 10 1m_Mar_out         1.11     1.42          0.699            0.757
## 11 1m_Apr_out         0.708    0.875         0.549            0.461
## # … with 2 more variables: MASE_fc_add_mDOW.fc_hw_a <dbl>,
## #   MASE_fc_add_mDOW.fc_hw_m <dbl>

Observations

• while using the DOW buckets method, compared the to the best additive method based on month and day of week, the combined model of holt-winter additive method combined with additive model has an overall lowest MASE value for the WARUK hotel

10.1.1 Create functions and models

lag_booking <- function(hotelname,lagday) {
  d_m <-nn_dataset %>% filter(hotel == hotelname) %>% select(c(stay_date,final_arrivals)) %>% distinct() %>% rename(lagdate = stay_date, date_book = final_arrivals)

  lag_booking<- nn_dataset %>% filter(hotel == hotelname) %>% mutate(lagdate = stay_date - lagday) %>% left_join(d_m,by = "lagdate") %>% select(date_book) %>%  rename(!!paste0("lag",lagday) := date_book)

  return(lag_booking)
}

10.2.1 create nn dataset

set.seed(12345)

#training_data <-  filled_data_full %>% filter(stay_date < '2009-11-1') # 2008-05-01 to 2009-10-31
#test_data <-  filled_data_full %>% filter(stay_date >= '2009-11-1')


# Choose lagday for the hotel
lagday <- c(1,2,3,4,5,6,7,14,21,364)

Mod_data_G <- cbind(nn_dataset[nn_dataset[, "hotel"] =="GLWST",],data.frame(lapply(lagday,lag_booking,hotelname="GLWST"))) %>% select(c("stay_date","CONF_DT","cum_bookings","final_arrivals","days_prior","lag1","lag2","lag3","lag4","lag5","lag6","lag7","lag14","lag21","lag364"))
Mod_data_G <- Mod_data_G %>% mutate(fc_naive=Mod_data_G$lag364 )

# check NA in columns
apply(Mod_data_G,2,function(x) sum(is.na(x)))

##      stay_date        CONF_DT   cum_bookings final_arrivals     days_prior 
##              0              0              0              0              0 
##           lag1           lag2           lag3           lag4           lag5 
##            175            292            603            915           1228 
##           lag6           lag7          lag14          lag21         lag364 
##           1342           1617           3151           4564          69027 
##       fc_naive 
##          69027

# omit NA in columns
Mod_data_G <-  na.omit(Mod_data_G) 


#scaled variables except dummy and denpendent variables
scaled_variables <- preProcess(Mod_data_G[,-c(4,ncol(Mod_data_G))])
NN_scaled_G <- Mod_data_G_scaled <- predict(scaled_variables,Mod_data_G)

# transfer dummy variables
#NN_scaled_G  <- fastDummies::dummy_cols(Mod_data_G_scaled,remove_first_dummy = TRUE,select_columns = c("DOW","month","quarter")) 

10.2.2 train training dataset

# Training dataset
NN_train_G <- NN_scaled_G %>% filter(stay_date < '2009-11-1')

# check variables in the dataset
glimpse(NN_train_G)

## Observations: 36,595
## Variables: 16
## $ stay_date      <date> 2009-04-30, 2009-04-30, 2009-04-30, 2009-04-30, …
## $ CONF_DT        <date> 2008-11-13, 2008-11-14, 2008-11-15, 2008-11-16, …
## $ cum_bookings   <dbl> -0.6520675, -0.6520675, -0.6520675, -0.6520675, -…
## $ final_arrivals <dbl> 117, 117, 117, 117, 117, 117, 117, 117, 117, 117,…
## $ days_prior     <dbl> 0.8805090, 0.8665870, 0.8526650, 0.8387430, 0.824…
## $ lag1           <dbl> 0.9190474, 0.9190474, 0.9190474, 0.9190474, 0.919…
## $ lag2           <dbl> 0.9788104, 0.9788104, 0.9788104, 0.9788104, 0.978…
## $ lag3           <dbl> -0.6814955, -0.6814955, -0.6814955, -0.6814955, -…
## $ lag4           <dbl> -1.375279, -1.375279, -1.375279, -1.375279, -1.37…
## $ lag5           <dbl> 0.9841595, 0.9841595, 0.9841595, 0.9841595, 0.984…
## $ lag6           <dbl> 0.893311, 0.893311, 0.893311, 0.893311, 0.893311,…
## $ lag7           <dbl> 0.1404054, 0.1404054, 0.1404054, 0.1404054, 0.140…
## $ lag14          <dbl> -0.3916876, -0.3916876, -0.3916876, -0.3916876, -…
## $ lag21          <dbl> 0.7083039, 0.7083039, 0.7083039, 0.7083039, 0.708…
## $ lag364         <dbl> 0.4138432, 0.4138432, 0.4138432, 0.4138432, 0.413…
## $ fc_naive       <dbl> 116, 116, 116, 116, 116, 116, 116, 116, 116, 116,…

# Fit the modle
n <- names(NN_train_G)
f <- as.formula(paste("final_arrivals ~", paste(n[!n %in% c("final_arrivals","stay_date","CONF_DT","fc_naive")], collapse = " + ")))


# method 1
nn_fit_G1 <- neuralnet(f,NN_train_G,hidden=c(0),linear.output=T,threshold=100,lifesign="full",lifesign.step=50)

## hidden: 0    thresh: 100    rep: 1/1    steps:      50   min thresh: 3287940.71386564
##                                                    100   min thresh: 2461442.55122172
##                                                    150   min thresh: 1905129.58186451
##                                                    200   min thresh: 1750757.08467301
##                                                    250   min thresh: 1632304.3830209
##                                                    300   min thresh: 1529972.48830384
##                                                    350   min thresh: 1426450.88004197
##                                                    400   min thresh: 1322359.94131812
##                                                    450   min thresh: 1218528.07761978
##                                                    500   min thresh: 1116256.47308815
##                                                    550   min thresh: 1009693.82383128
##                                                    600   min thresh: 908267.489472109
##                                                    650   min thresh: 802796.580165802
##                                                    700   min thresh: 700539.31681408
##                                                    750   min thresh: 598141.438603911
##                                                    800   min thresh: 494807.206554517
##                                                    850   min thresh: 390413.01358989
##                                                    900   min thresh: 286895.273556604
##                                                    950   min thresh: 181934.107176451
##                                                   1000   min thresh: 80253.9001254068
##                                                   1050   min thresh: 605.657855171973
##                                                   1082   error: 4334897.98201    time: 2.67 secs

#plot(nn_fit_G1)
result_train_G <- data.frame(NN_train_G$stay_date, NN_train_G$CONF_DT, nn_fit_G1$net.result,"GLWST")
names(result_train_G)= c("stay_date", "CONF_DT","fc_nn","hotel")

10.2.3 fit the test dataset

# Test dataset

NN_test_G <- NN_scaled_G %>% filter(stay_date >= '2009-11-1')

# check variables in the dataset
#glimpse(NN_testdataset_G )

# check NA in columns
#apply(NN_test_G,2,function(x) sum(is.na(x)))

# forecast the training model
NN_pred_test_G1 <- neuralnet::compute(nn_fit_G1,NN_test_G[-c(4)])
result_test_G<- data.frame(stay_date = NN_test_G$stay_date, CONF_DT = NN_test_G$CONF_DT,actual= NN_test_G$final_arrivals, fc_nn = NN_pred_test_G1$net.result,fc_naive =NN_test_G$fc_naive)


# merge dataset as the daysprior format
result_test_NN_G <- fc_hw_daysprior(1,"additive") %>% select(c("stay_date","CONF_DT","forecast_period") )%>% left_join(result_test_G, by = c("stay_date","CONF_DT")) %>% na.omit()  %>% cbind(hotel="GLWST")

# calculate NN models errors 
nn_result_out_G <- result_test_NN_G  %>%
group_by(forecast_period) %>% 
            # MAE error measurements
  summarise( MAE_nn = sum(abs(actual-fc_nn))/n(),
             MAE_naive = sum(abs(actual-fc_naive))/n(),
            # MAPE error measurements
             MAPE_nn = sum(abs(actual-fc_nn)/actual)/n(),
            
            # MASE error measurements compared to naive model
             MASE_nn = MAE_nn/MAE_naive)

nn_result_out_G<-txtRound(nn_result_out_G[,-1],2)
nn_result_out_G <- data.frame(forecast_period=fc_timestamp_out,nn_result_out_G) 
htmlTable(nn_result_out_G)

10.3.1 create nn dataset

set.seed(12345)

#training_data <-  filled_data_full %>% filter(stay_date < '2009-11-1') # 2008-05-01 to 2009-10-31
#test_data <-  filled_data_full %>% filter(stay_date >= '2009-11-1')


# Choose lagday for the hotel
lagday <- c(1,2,3,4,5,6,7,14,21,364)

Mod_data_M <- cbind(nn_dataset[nn_dataset[, "hotel"] =="MLKEP",],data.frame(lapply(lagday,lag_booking,hotelname="MLKEP"))) %>% select(c("stay_date","CONF_DT","cum_bookings","final_arrivals","days_prior","lag1","lag2","lag3","lag4","lag5","lag6","lag7","lag14","lag21","lag364"))
Mod_data_M <- Mod_data_M %>% mutate(fc_naive=Mod_data_M$lag364 )

# check NA in columns
apply(Mod_data_M,2,function(x) sum(is.na(x)))

##      stay_date        CONF_DT   cum_bookings final_arrivals     days_prior 
##              0              0              0              0              0 
##           lag1           lag2           lag3           lag4           lag5 
##             90            197            320            429            558 
##           lag6           lag7          lag14          lag21         lag364 
##            688            753           1243           1629          33913 
##       fc_naive 
##          33913

# omit NA in columns
Mod_data_M <-  na.omit(Mod_data_M) 


#scaled variables except dummy and denpendent variables
scaled_variables <- preProcess(Mod_data_M[,-c(4,ncol(Mod_data_M))])
NN_scaled_M <- Mod_data_M_scaled <- predict(scaled_variables,Mod_data_M)

# transfer dummy variables
#NN_scaled_G  <- fastDummies::dummy_cols(Mod_data_G_scaled,remove_first_dummy = TRUE,select_columns = c("DOW","month","quarter")) 

10.3.2 train the dataset

# Training dataset
NN_train_M <- NN_scaled_M %>% filter(stay_date < '2009-11-1')

# check variables in the dataset
#glimpse(NN_train_M)


# Fit the modle
n <- names(NN_train_M)
f <- as.formula(paste("final_arrivals ~", paste(n[!n %in% c("final_arrivals","stay_date","CONF_DT","fc_naive")], collapse = " + ")))


# method 1
nn_fit_M1 <- neuralnet(f,NN_train_M,hidden=c(0),linear.output=T,threshold=100,lifesign="full",lifesign.step=50)

## hidden: 0    thresh: 100    rep: 1/1    steps:      50   min thresh: 2690765.35205737
##                                                    100   min thresh: 2472193.47866376
##                                                    150   min thresh: 2275886.68673817
##                                                    200   min thresh: 2109977.64399122
##                                                    250   min thresh: 1971424.57576136
##                                                    300   min thresh: 1847326.59100435
##                                                    350   min thresh: 1722876.26618413
##                                                    400   min thresh: 1598414.58062551
##                                                    450   min thresh: 1473861.2270335
##                                                    500   min thresh: 1349438.11026541
##                                                    550   min thresh: 1225383.24490788
##                                                    600   min thresh: 1100634.30196423
##                                                    650   min thresh: 976075.3076495
##                                                    700   min thresh: 851829.808584916
##                                                    750   min thresh: 727225.264395953
##                                                    800   min thresh: 602662.677088679
##                                                    850   min thresh: 478533.297001231
##                                                    900   min thresh: 353881.848832607
##                                                    950   min thresh: 229793.235046016
##                                                   1000   min thresh: 105149.241001303
##                                                   1050   min thresh: 351.685367844636
##                                                   1055   error: 9861383.10098    time: 2.09 secs

#plot(nn_fit_M1)
result_train_M <- data.frame(NN_train_M$stay_date, NN_train_M$CONF_DT, nn_fit_M1$net.result,"MLKEP")
names(result_train_M)= c("stay_date", "CONF_DT","fc_nn","hotel") 

10.3.3 fit the dataset

# Test dataset

NN_test_M <- NN_scaled_M %>% filter(stay_date >= '2009-11-1')

# check variables in the dataset
#glimpse(NN_testdataset_M )

# check NA in columns
#apply(NN_test_M,2,function(x) sum(is.na(x)))

# forecast the training model
NN_pred_test_M1 <- neuralnet::compute(nn_fit_M1,NN_test_M[-c(4)])
result_test_M1<- data.frame(stay_date = NN_test_M$stay_date, CONF_DT = NN_test_M$CONF_DT,actual= NN_test_M$final_arrivals, fc_nn = NN_pred_test_M1$net.result,fc_naive =NN_test_M$fc_naive)


# merge dataset as the daysprior format
result_test_NN_M <- fc_hw_daysprior(2,"additive") %>% select(c("stay_date","CONF_DT","forecast_period") )%>% left_join(result_test_M1, by = c("stay_date","CONF_DT")) %>% na.omit() %>% cbind(hotel="MLKEP")


# calculate NN models errors 
nn_result_out_M <-result_test_NN_M  %>%
group_by(forecast_period) %>% 
            # MAE error measurements
  summarise( MAE_nn = sum(abs(actual-fc_nn))/n(),
             MAE_naive  = sum(abs(actual-fc_naive))/n(),
            # MAPE error measurements
            MAPE_nn = sum(abs(actual-fc_nn)/actual)/n(),
            
            # MASE error measurements compared to naive model
            MASE_nn = MAE_nn/MAE_naive)

nn_result_out_M<-txtRound(nn_result_out_M[,-1],2)
nn_result_out_M <- data.frame(forecast_period=fc_timestamp_out,nn_result_out_M) 
htmlTable(nn_result_out_M)

10.4.1 create nn dataset

set.seed(12345)

#training_data <-  filled_data_full %>% filter(stay_date < '2009-11-1') # 2008-05-01 to 2009-10-31
#test_data <-  filled_data_full %>% filter(stay_date >= '2009-11-1')


# Choose lagday for the hotel
lagday <- c(1,2,3,4,5,6,7,14,21,364)

Mod_data_W <- cbind(nn_dataset[nn_dataset[, "hotel"] =="WARUK",],data.frame(lapply(lagday,lag_booking,hotelname="WARUK"))) %>% select(c("stay_date","CONF_DT","cum_bookings","final_arrivals","days_prior","lag1","lag2","lag3","lag4","lag5","lag6","lag7","lag14","lag21","lag364"))
Mod_data_W <- Mod_data_W %>% mutate(fc_naive=Mod_data_W$lag364 )

# check NA in columns
apply(Mod_data_W,2,function(x) sum(is.na(x)))

##      stay_date        CONF_DT   cum_bookings final_arrivals     days_prior 
##              0              0              0              0              0 
##           lag1           lag2           lag3           lag4           lag5 
##            177            325            474            624            638 
##           lag6           lag7          lag14          lag21         lag364 
##            747            852           2088           3365          52751 
##       fc_naive 
##          52751

# omit NA in columns
Mod_data_W <-  na.omit(Mod_data_W) 


#scaled variables except dummy and denpendent variables
scaled_variables <- preProcess(Mod_data_W[,-c(4,ncol(Mod_data_W))])
NN_scaled_W <- Mod_data_W_scaled <- predict(scaled_variables,Mod_data_W)

# transfer dummy variables
#NN_scaled_G  <- fastDummies::dummy_cols(Mod_data_G_scaled,remove_first_dummy = TRUE,select_columns = c("DOW","month","quarter")) 

10.4.2 train the dataset

# Training dataset
NN_train_W <- NN_scaled_W %>% filter(stay_date < '2009-11-1')

# check variables in the dataset
#glimpse(NN_train_W)


# Fit the modle
n <- names(NN_train_W)
f <- as.formula(paste("final_arrivals ~", paste(n[!n %in% c("final_arrivals","stay_date","CONF_DT","fc_naive")], collapse = " + ")))


# method 1
nn_fit_W1 <- neuralnet(f,NN_train_W,hidden=c(0),linear.output=T,threshold=100,lifesign="full",lifesign.step=50)

## hidden: 0    thresh: 100    rep: 1/1    steps:      50   min thresh: 2459756.8423652
##                                                    100   min thresh: 1782671.95176147
##                                                    150   min thresh: 1365755.43802059
##                                                    200   min thresh: 1223615.97345192
##                                                    250   min thresh: 1113100.05744893
##                                                    300   min thresh: 996556.011691862
##                                                    350   min thresh: 884038.04156948
##                                                    400   min thresh: 770162.497638148
##                                                    450   min thresh: 656633.809364625
##                                                    500   min thresh: 543016.800066574
##                                                    550   min thresh: 428717.399948547
##                                                    600   min thresh: 315764.783944399
##                                                    650   min thresh: 203449.532244018
##                                                    700   min thresh: 88259.4762028119
##                                                    750   min thresh: 471.932712521617
##                                                    759   error: 6691634.46756    time: 1.88 secs

#plot(nn_fit_W1)
result_train_W <- data.frame(NN_train_W$stay_date, NN_train_W$CONF_DT, nn_fit_W1$net.result,"WARUK")
names(result_train_W)= c("stay_date", "CONF_DT","fc_nn","hotel") 

10.4.3 fit the dataset

# Test dataset

NN_test_W <- NN_scaled_W %>% filter(stay_date >= '2009-11-1')

# check variables in the dataset
#glimpse(NN_testdataset_W )

# check NA in columns
#apply(NN_test_W,2,function(x) sum(is.na(x)))

# forecast the training model
NN_pred_test_W1 <- neuralnet::compute(nn_fit_W1,NN_test_W[-c(4)])
result_test_W1<- data.frame(stay_date = NN_test_W$stay_date, CONF_DT = NN_test_W$CONF_DT,actual= NN_test_W$final_arrivals, fc_nn = NN_pred_test_W1$net.result,fc_naive =NN_test_W$fc_naive)


# merge dataset as the daysprior format
result_test_NN_W <- fc_hw_daysprior(3,"additive") %>% select(c("stay_date","CONF_DT","forecast_period") )%>% left_join(result_test_W1, by = c("stay_date","CONF_DT")) %>% na.omit() %>% cbind(hotel="WARUK")


# calculate NN models errors 
nn_result_out_W<- result_test_NN_W %>%
group_by(forecast_period) %>% 
            # MAE error measurements
  summarise( MAE_nn = sum(abs(actual-fc_nn))/n(),
             MAE_naive  = sum(abs(actual-fc_naive))/n(),
            # MAPE error measurements
            MAPE_nn = sum(abs(actual-fc_nn)/actual)/n(),
            
            # MASE error measurements compared to naive model
            MASE_nn = MAE_nn/MAE_naive)


nn_result_out_W<-txtRound(nn_result_out_W[,-1],2)
nn_result_out_W <- data.frame(forecast_period=fc_timestamp_out,nn_result_out_W) 
htmlTable(nn_result_out_W)

11.1.1 define insample dataset function

in_fitcompare_dataset <- function(hotelname,factor) {
# fit combined models to get coefficient from training data
fc1<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add","fc_hw_a",factor) 
dataset1<-fc1$dataset
fc2<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_a",factor) 
dataset2<-fc2$dataset
fc3<- fc_combined_weight(in_compare_dataset,hotelname,"fc_add_mDOW","fc_hw_m",factor) 
dataset3<-fc3$dataset

# store the combined model parameters as parameter datasets for later join with out-sample data
coe_fc_add.fc_hw_a <- dataset1[,c(1,which(names(dataset1) == factor),(ncol(dataset1)-2):ncol(dataset1))] %>% distinct()
coe_fc_add_mDOW.fc_hw_a <- dataset2[,c(1,which(names(dataset2) == factor),(ncol(dataset2)-2):ncol(dataset2))] %>% distinct()
coe_fc_add_mDOW.fc_hw_m <- dataset3[,c(1,which(names(dataset3) == factor),(ncol(dataset3)-2):ncol(dataset3))] %>% distinct()

# get out-sample forecast data using hw_additive and hw multiplicative model
if(hotelname == "GLWST") {
   hotelno<-1
} else if (hotelname == "MLKEP") {
    hotelno<-2
} else {
  hotelno<-3}

# calculte the combined-fc result for in sample model
in_fitcompare_dataset<- in_compare_dataset %>%
  
  # merge with the parameters dataset calculated from in sample dataset
  merge(coe_fc_add.fc_hw_a, by = c("hotel",factor)) %>%
  merge(coe_fc_add_mDOW.fc_hw_a, by = c("hotel",factor))  %>%
  merge(coe_fc_add_mDOW.fc_hw_m, by = c("hotel",factor))  %>% 
  filter(days_prior!=0)  %>%  # filter out final_day forecast

  # model combined fc_add and fc_hw_a 
  mutate(fc_add.fc_hw_a = interc.fc_add.fc_hw_a + coef1.fc_add.fc_hw_a*fc_add + coef2.fc_add.fc_hw_a*fc_hw_a ) %>% 
  # model combined fc_mDOW and fc_hw_a 
  mutate(fc_add_mDOW.fc_hw_a = interc.fc_add_mDOW.fc_hw_a + coef1.fc_add_mDOW.fc_hw_a*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_a *fc_hw_a ) %>%
  # model combined fc_mDOW and fc_hw_m
  mutate(fc_add_mDOW.fc_hw_m = interc.fc_add_mDOW.fc_hw_m + coef1.fc_add_mDOW.fc_hw_m*fc_add_mDOW + coef2.fc_add_mDOW.fc_hw_m *fc_hw_m )   %>% select(-(13:21)) # drop columns with the coefficient datas
  # drop NA rows from the out compare dataset
  in_fitcompare_dataset <- na.omit( in_fitcompare_dataset)

return(in_fitcompare_dataset)
}

11.1.2 create insample and outsample essemble dataset

# insample fc arrvials from NN model
NN_infc_dataset <- rbind(result_train_G,result_train_M,result_train_W)


# insample fc arrvials from Other models we use in combined models
Other_infc_dataset <- rbind(in_fitcompare_dataset("GLWST","DOW"),in_fitcompare_dataset("MLKEP","DOW"),in_fitcompare_dataset("WARUK","DOW"))
Other_infc_dataset2 <- rbind(in_fitcompare_dataset("GLWST","days_prior_c"),in_fitcompare_dataset("MLKEP","days_prior_c"),in_fitcompare_dataset("WARUK","days_prior_c"))

# merge fc from other models  with the nn models
final_infc_dataset<- merge(Other_infc_dataset,Other_infc_dataset2,by= c(names(Other_infc_dataset[,-(13:15)])),suffixes=c("__DOW","__dpr")) %>% merge(NN_infc_dataset,by = c("stay_date","CONF_DT","hotel"))

names(final_infc_dataset)

##  [1] "stay_date"                "CONF_DT"                 
##  [3] "hotel"                    "DOW"                     
##  [5] "days_prior"               "days_prior_c"            
##  [7] "final_arrivals"           "fc_add_mDOW"             
##  [9] "fc_add"                   "fc_mul"                  
## [11] "fc_hw_a"                  "fc_hw_m"                 
## [13] "fc_add.fc_hw_a__DOW"      "fc_add_mDOW.fc_hw_a__DOW"
## [15] "fc_add_mDOW.fc_hw_m__DOW" "fc_add.fc_hw_a__dpr"     
## [17] "fc_add_mDOW.fc_hw_a__dpr" "fc_add_mDOW.fc_hw_m__dpr"
## [19] "fc_nn"

# outsample fc arrvials from NN model
NN_outfc_dataset <- rbind(result_test_NN_G,result_test_NN_M,result_test_NN_W) %>% select("stay_date","CONF_DT","hotel","fc_nn","forecast_period")


# outsample fc arrvials from Other models we use in combined models
Other_outfc_dataset <- rbind(out_compare_dataset("GLWST","DOW"),out_compare_dataset("MLKEP","DOW"),out_compare_dataset("WARUK","DOW"))
Other_outfc_dataset2 <- rbind(out_compare_dataset("GLWST","days_prior_c"),out_compare_dataset("MLKEP","days_prior_c"),out_compare_dataset("WARUK","days_prior_c"))

# merge fc from other models  with the nn models
final_outfc_dataset<- merge(Other_outfc_dataset,Other_outfc_dataset2,by= c(names(Other_outfc_dataset[,-(16:18)])),suffixes=c("__DOW","__dpr")) %>% left_join(NN_outfc_dataset,by = c("stay_date","CONF_DT","hotel","forecast_period"))

11.1.3 define outfit error matrix function

essemble_result_error <- function(dataset) {
  essemble_error_matix<- dataset %>%
group_by(forecast_period)  %>%
           # MAE error measurements
  summarise(MAE_naive = sum(abs(final_arrivals-fc_naive))/n(),
            MAE_add = sum(abs(final_arrivals-fc_add))/n(),
            MAE_mul = sum(abs(final_arrivals-fc_mul))/n(),
            MAE_add_mDOW = sum(abs(final_arrivals-fc_add_mDOW))/n(),
            MAE_add.hw_a__DOW = sum(abs(final_arrivals-fc_add.fc_hw_a__DOW))/n(),
            MAE_add_mDOW.hw_m__DOW = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__DOW))/n(),
            MAE_add.hw_a__dpr = sum(abs(final_arrivals-fc_add.fc_hw_a__dpr))/n(),
            MAE_add_mDOW.hw_a__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_a__dpr))/n(),
            MAE_add_mDOW.hw_m__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__dpr))/n(),
            MAE_nn = sum(abs(final_arrivals-fc_nn))/n(),
            MAE_glm_st = sum(abs(final_arrivals-fc_glm_stacked))/n(),
            # MAPE error measurements
            MAPE_add = sum(abs(final_arrivals-fc_add)/abs(final_arrivals))/n(),
            MAPE_mul = sum(abs(final_arrivals-fc_mul)/abs(final_arrivals))/n(),
            MAPE_add_mDOW = sum(abs(final_arrivals-fc_add_mDOW)/abs(final_arrivals))/n(),
            MAPE_add.hw_a__DOW = sum(abs(final_arrivals-fc_add.fc_hw_a__DOW)/abs(final_arrivals))/n(),
            MAPE_add_mDOW.hw_m__DOW = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__DOW)/abs(final_arrivals))/n(),
            MAPE_add.hw_a__dpr = sum(abs(final_arrivals-fc_add.fc_hw_a__dpr)/abs(final_arrivals))/n(),
            MAPE_add_mDOW.hw_a__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_a__dpr)/abs(final_arrivals))/n(),
            MAPE_add_mDOW.hw_m__dpr = sum(abs(final_arrivals-fc_add_mDOW.fc_hw_m__dpr)/abs(final_arrivals))/n(),
            MAPE_nn = sum(abs(final_arrivals-fc_nn)/abs(final_arrivals))/n(),
            MAPE_glm_st = sum(abs(final_arrivals-fc_glm_stacked)/abs(final_arrivals))/n(),
            # MASE error measurements compared to naive model
            MASE_add =  MAE_add/MAE_naive,
            MASE_mul =  MAE_mul/MAE_naive,
            MASE_add_mDOW = MAE_add_mDOW/MAE_naive,
            MASE_add.hw_a_DOW = MAE_add.hw_a__DOW/MAE_naive,
            MASE_add_mDOW.hw_m__DOW = MAE_add_mDOW.hw_m__DOW/MAE_naive,
            MASE_add.hw_a__dpr = MAE_add.hw_a__dpr/MAE_naive,
            MASE_add_mDOW.hw_a__dpr = MAE_add_mDOW.hw_a__dpr/MAE_naive,
            MASE_add_mDOW.hw_m__dpr = MAE_add_mDOW.hw_m__dpr/MAE_naive,
            MASE_nn = MAE_nn/MAE_naive,
            MASE_glm_st = MAE_glm_st/MAE_naive)
  
  return(essemble_error_matix)
  
}

11.2.1 train the top layer model on the predictions of the bottom layer models that has been made on the insample data

# Defining the training control
cvCtrl <- trainControl(method="repeatedcv", repeats=3)

nnetGrid <-  expand.grid(size = seq(from = 1, to = 10, by = 1),
                        decay = seq(from = 0.1, to = 0.5, by = 0.1))

#Predictors for top layer models 
final_infc_datase_G<-final_infc_dataset %>% filter(hotel == "GLWST")

predictors_top<-c('fc_add','fc_mul','fc_hw_a','fc_add_mDOW',"fc_add.fc_hw_a__DOW","fc_add_mDOW.fc_hw_a__DOW", "fc_add_mDOW.fc_hw_m__DOW","fc_add.fc_hw_a__dpr","fc_add_mDOW.fc_hw_a__dpr" ,"fc_add_mDOW.fc_hw_m__dpr","fc_nn") 
outcomeName <- "final_arrivals"

#Neuralnet as top layer model 
model_glm<- 
train(final_infc_datase_G[,predictors_top],final_infc_datase_G[,outcomeName],
      method='glm',trControl=cvCtrl,tuneLength=3)

11.2.2 using the model fitted in the training dataset to predit the test dataset

#predict using GBM top layer model
final_outfc_dataset_G <- final_outfc_dataset %>% filter(hotel == "GLWST")


final_outfc_dataset_G$fc_glm_stacked<-predict(model_glm,final_outfc_dataset_G[,predictors_top])


# essemble data model result
essem_result_G<- essemble_result_error(final_outfc_dataset_G)
essem_result_G_com <- essem_result_G %>% select("MAE_glm_st","MAPE_glm_st","MASE_glm_st")
essem_result_G_com <- txtRound(essem_result_G_com,2)
essem_result_G_com <- data.frame(forecast_period = fc_timestamp_out,essem_result_G_com )
htmlTable(essem_result_G_com)

# MAE, MAPE, MASE result
essem_result_G_MAE <- essem_result_G[names(essem_result_G) %like% "MAE" | names(essem_result_G) == "forecast_period"]
essem_result_G_MAE 

## # A tibble: 11 x 12
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_add.hw_a__D…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       17.9    21.9    49.3         17.3            20.7 
##  2 3m_Nov-Jan_out       18.6    24.8    37.0         18.1            23.4 
##  3 3m_Dec-Feb_out       16.9    22.7    37.3         15.8            24.1 
##  4 3m_Jan-Mar_out       16.7    16.8    46.0         13.9            18.7 
##  5 3m_Feb-Apr_out       21.0    14.5    40.1         14.7            14.1 
##  6 1m_Nov_out           17.3    13.4    31.6         14.5             9.71
##  7 1m_Dec_out           21.4    15.4    25.2         13.4            17.9 
##  8 1m_Jan_out           15.7    14.1    27.5         11.9            20.8 
##  9 1m_Feb_out           13.2    11.4    24.1         11.3            12.8 
## 10 1m_Mar_out           26.9    12.5    25.3         11.1            10.9 
## 11 1m_Apr_out           22.2    13.1    34.7         10.5            11.9 
## # … with 6 more variables: MAE_add_mDOW.hw_m__DOW <dbl>,
## #   MAE_add.hw_a__dpr <dbl>, MAE_add_mDOW.hw_a__dpr <dbl>,
## #   MAE_add_mDOW.hw_m__dpr <dbl>, MAE_nn <dbl>, MAE_glm_st <dbl>

essem_result_G_MAPE <- essem_result_G[names(essem_result_G) %like% "MAPE" | names(essem_result_G) == "forecast_period"]
essem_result_G_MAPE

## # A tibble: 11 x 11
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_add.hw_a__…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     0.374    0.520         0.269           0.368 
##  2 3m_Nov-Jan_out     0.478    0.428         0.317           0.475 
##  3 3m_Dec-Feb_out     0.440    0.476         0.278           0.480 
##  4 3m_Jan-Mar_out     0.243    0.548         0.193           0.291 
##  5 3m_Feb-Apr_out     0.178    0.436         0.183           0.177 
##  6 1m_Nov_out         0.138    0.301         0.139           0.0998
##  7 1m_Dec_out         0.378    0.337         0.281           0.453 
##  8 1m_Jan_out         0.271    0.418         0.192           0.417 
##  9 1m_Feb_out         0.137    0.263         0.133           0.160 
## 10 1m_Mar_out         0.133    0.274         0.128           0.119 
## 11 1m_Apr_out         0.143    0.387         0.116           0.130 
## # … with 6 more variables: MAPE_add_mDOW.hw_m__DOW <dbl>,
## #   MAPE_add.hw_a__dpr <dbl>, MAPE_add_mDOW.hw_a__dpr <dbl>,
## #   MAPE_add_mDOW.hw_m__dpr <dbl>, MAPE_nn <dbl>, MAPE_glm_st <dbl>

essem_result_G_MASE <- essem_result_G[names(essem_result_G) %like% "MASE" | names(essem_result_G) == "forecast_period"]
essem_result_G_MASE

## # A tibble: 11 x 11
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_add.hw_a_D…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.22     2.76          0.966            1.16 
##  2 3m_Nov-Jan_out     1.33     1.98          0.973            1.25 
##  3 3m_Dec-Feb_out     1.34     2.21          0.934            1.43 
##  4 3m_Jan-Mar_out     1.01     2.76          0.837            1.12 
##  5 3m_Feb-Apr_out     0.689    1.91          0.696            0.671
##  6 1m_Nov_out         0.774    1.82          0.838            0.560
##  7 1m_Dec_out         0.717    1.18          0.625            0.836
##  8 1m_Jan_out         0.894    1.75          0.757            1.32 
##  9 1m_Feb_out         0.861    1.82          0.853            0.963
## 10 1m_Mar_out         0.463    0.938         0.414            0.404
## 11 1m_Apr_out         0.588    1.56          0.474            0.535
## # … with 6 more variables: MASE_add_mDOW.hw_m__DOW <dbl>,
## #   MASE_add.hw_a__dpr <dbl>, MASE_add_mDOW.hw_a__dpr <dbl>,
## #   MASE_add_mDOW.hw_m__dpr <dbl>, MASE_nn <dbl>, MASE_glm_st <dbl>

11.3.1 train the top layer model on the predictions of the bottom layer models that has been made on the insample data

# Defining the training control
cvCtrl <- trainControl(method="repeatedcv", repeats=3)

nnetGrid <-  expand.grid(size = seq(from = 1, to = 10, by = 1),
                        decay = seq(from = 0.1, to = 0.5, by = 0.1))

#Predictors for top layer models 
final_infc_datase_M<-final_infc_dataset %>% filter(hotel == "MLKEP")

predictors_top<-c('fc_add','fc_mul','fc_hw_a','fc_add_mDOW',"fc_add.fc_hw_a__DOW","fc_add_mDOW.fc_hw_a__DOW", "fc_add_mDOW.fc_hw_m__DOW","fc_add.fc_hw_a__dpr","fc_add_mDOW.fc_hw_a__dpr" ,"fc_add_mDOW.fc_hw_m__dpr","fc_nn") 
outcomeName <- "final_arrivals"

#Neuralnet as top layer model 
model_glm<- 
train(final_infc_datase_M[,predictors_top],final_infc_datase_M[,outcomeName],
      method='glm',trControl=cvCtrl,tuneLength=3)

11.3.2 using the model fitted in the training dataset to predit the test dataset

#predict using GBM top layer model
final_outfc_dataset_M <- final_outfc_dataset %>% filter(hotel == "MLKEP")

final_outfc_dataset_M$fc_glm_stacked<-predict(model_glm,final_outfc_dataset_M[,predictors_top])


# essemble data model result
essem_result_M<- essemble_result_error(final_outfc_dataset_M)
essem_result_M_com <- essem_result_M %>% select("MAE_glm_st","MAPE_glm_st","MASE_glm_st")
essem_result_M_com <- txtRound(essem_result_M_com,2)
essem_result_M_com <- data.frame(forecast_period = fc_timestamp_out,essem_result_M_com )
htmlTable(essem_result_M_com)

# MAE, MAPE, MASE result
essem_result_M_MAE <- essem_result_M[names(essem_result_M) %like% "MAE" | names(essem_result_M) == "forecast_period"]
essem_result_M_MAE 

## # A tibble: 11 x 12
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_add.hw_a__D…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       19.9    42.9    51.2        25.0              30.1
##  2 3m_Nov-Jan_out       19.6    44.3    52.7        25.3              31.1
##  3 3m_Dec-Feb_out       19.2    40.5    48.8        26.3              27.5
##  4 3m_Jan-Mar_out       16.2    39.6    58.5        18.1              21.2
##  5 3m_Feb-Apr_out       16.2    37.9    62.5        14.9              19.0
##  6 1m_Nov_out           20.7    37.0    38.4        14.0              25.0
##  7 1m_Dec_out           20.2    35.6    26.5        29.2              33.0
##  8 1m_Jan_out           16.7    39.1    40.9        20.3              25.3
##  9 1m_Feb_out           13.8    31.3    33.6         9.83             14.5
## 10 1m_Mar_out           17.1    31.4    35.3        13.5              15.4
## 11 1m_Apr_out           24      34.3    34.3        12.9              16.1
## # … with 6 more variables: MAE_add_mDOW.hw_m__DOW <dbl>,
## #   MAE_add.hw_a__dpr <dbl>, MAE_add_mDOW.hw_a__dpr <dbl>,
## #   MAE_add_mDOW.hw_m__dpr <dbl>, MAE_nn <dbl>, MAE_glm_st <dbl>

essem_result_M_MAPE <- essem_result_M[names(essem_result_M) %like% "MAPE" | names(essem_result_M) == "forecast_period"]
essem_result_M_MAPE

## # A tibble: 11 x 11
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_add.hw_a__…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     0.741    0.652         0.439            0.581
##  2 3m_Nov-Jan_out     0.761    0.680         0.458            0.615
##  3 3m_Dec-Feb_out     0.783    0.571         0.503            0.600
##  4 3m_Jan-Mar_out     0.597    0.510         0.229            0.290
##  5 3m_Feb-Apr_out     0.533    0.610         0.194            0.260
##  6 1m_Nov_out         0.371    0.334         0.126            0.263
##  7 1m_Dec_out         0.765    0.442         0.679            0.835
##  8 1m_Jan_out         0.746    0.365         0.295            0.401
##  9 1m_Feb_out         0.406    0.344         0.114            0.182
## 10 1m_Mar_out         0.388    0.358         0.159            0.157
## 11 1m_Apr_out         0.433    0.368         0.156            0.199
## # … with 6 more variables: MAPE_add_mDOW.hw_m__DOW <dbl>,
## #   MAPE_add.hw_a__dpr <dbl>, MAPE_add_mDOW.hw_a__dpr <dbl>,
## #   MAPE_add_mDOW.hw_m__dpr <dbl>, MAPE_nn <dbl>, MAPE_glm_st <dbl>

essem_result_M_MASE <- essem_result_M[names(essem_result_M) %like% "MASE" | names(essem_result_M) == "forecast_period"]
essem_result_M_MASE

## # A tibble: 11 x 11
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_add.hw_a_D…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out      2.16     2.58         1.26             1.51 
##  2 3m_Nov-Jan_out      2.25     2.68         1.29             1.58 
##  3 3m_Dec-Feb_out      2.11     2.54         1.37             1.43 
##  4 3m_Jan-Mar_out      2.44     3.61         1.12             1.31 
##  5 3m_Feb-Apr_out      2.34     3.86         0.922            1.17 
##  6 1m_Nov_out          1.79     1.86         0.678            1.21 
##  7 1m_Dec_out          1.76     1.31         1.45             1.63 
##  8 1m_Jan_out          2.35     2.45         1.22             1.52 
##  9 1m_Feb_out          2.27     2.44         0.715            1.06 
## 10 1m_Mar_out          1.83     2.06         0.786            0.897
## 11 1m_Apr_out          1.43     1.43         0.537            0.671
## # … with 6 more variables: MASE_add_mDOW.hw_m__DOW <dbl>,
## #   MASE_add.hw_a__dpr <dbl>, MASE_add_mDOW.hw_a__dpr <dbl>,
## #   MASE_add_mDOW.hw_m__dpr <dbl>, MASE_nn <dbl>, MASE_glm_st <dbl>

11.4.1 train the top layer model on the predictions of the bottom layer models that has been made on the insample data

# Defining the training control
cvCtrl <- trainControl(method="repeatedcv", repeats=3)

nnetGrid <-  expand.grid(size = seq(from = 1, to = 10, by = 1),
                        decay = seq(from = 0.1, to = 0.5, by = 0.1))

#Predictors for top layer models 
final_infc_datase_W<-final_infc_dataset %>% filter(hotel == "WARUK")

predictors_top<-c('fc_add','fc_mul','fc_hw_a','fc_add_mDOW',"fc_add.fc_hw_a__DOW","fc_add_mDOW.fc_hw_a__DOW", "fc_add_mDOW.fc_hw_m__DOW","fc_add.fc_hw_a__dpr","fc_add_mDOW.fc_hw_a__dpr" ,"fc_add_mDOW.fc_hw_m__dpr","fc_nn") 
outcomeName <- "final_arrivals"

#Neuralnet as top layer model 
model_glm<- 
train(final_infc_datase_G[,predictors_top],final_infc_datase_G[,outcomeName],
      method='glm',trControl=cvCtrl,tuneLength=3)

11.4.2 using the model fitted in the training dataset to predit the test dataset

#predict using GBM top layer model
final_outfc_dataset_W <- final_outfc_dataset %>% filter(hotel == "WARUK")

final_outfc_dataset_W$fc_glm_stacked<-predict(model_glm,final_outfc_dataset_W[,predictors_top])


# essemble data model result
essem_result_W<- essemble_result_error(final_outfc_dataset_W)
essem_result_W_com <- essem_result_W %>% select("MAE_glm_st","MAPE_glm_st","MASE_glm_st")
essem_result_W_com <- txtRound(essem_result_W[-1],2)
essem_result_W_com <- data.frame(forecast_period = fc_timestamp_out,essem_result_W_com )
htmlTable(essem_result_W_com)

# MAE, MAPE, MASE result
essem_result_W_MAE <- essem_result_W[names(essem_result_W) %like% "MAE" | names(essem_result_W) == "forecast_period"]
essem_result_W_MAE

## # A tibble: 11 x 12
##    forecast_period MAE_naive MAE_add MAE_mul MAE_add_mDOW MAE_add.hw_a__D…
##    <fct>               <dbl>   <dbl>   <dbl>        <dbl>            <dbl>
##  1 6m_Nov-Apr_out       22.3    32.8    33.3        18.0              21.2
##  2 3m_Nov-Jan_out       24.1    34.5    29.9        18.0              21.8
##  3 3m_Dec-Feb_out       19.8    32.0    32.4        16.6              23.0
##  4 3m_Jan-Mar_out       15.8    26.3    39.0        14.0              16.4
##  5 3m_Feb-Apr_out       17.9    22.3    32.0        16.3              14.5
##  6 1m_Nov_out           26.9    26.9    28.5        15.0              11.9
##  7 1m_Dec_out           26.3    28.4    23.4        18.9              24.7
##  8 1m_Jan_out           17.3    27.8    28.9         9.07             15.1
##  9 1m_Feb_out           13.2    20.8    22.8        14.0              13.6
## 10 1m_Mar_out           17.9    19.9    25.5        12.5              13.6
## 11 1m_Apr_out           31.5    22.3    27.6        17.3              14.5
## # … with 6 more variables: MAE_add_mDOW.hw_m__DOW <dbl>,
## #   MAE_add.hw_a__dpr <dbl>, MAE_add_mDOW.hw_a__dpr <dbl>,
## #   MAE_add_mDOW.hw_m__dpr <dbl>, MAE_nn <dbl>, MAE_glm_st <dbl>

essem_result_W_MAPE <- essem_result_W[names(essem_result_W) %like% "MAPE" | names(essem_result_W) == "forecast_period"]
essem_result_W_MAPE

## # A tibble: 11 x 11
##    forecast_period MAPE_add MAPE_mul MAPE_add_mDOW MAPE_add.hw_a__…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.05     0.537         0.461            0.636
##  2 3m_Nov-Jan_out     1.20     0.548         0.515            0.721
##  3 3m_Dec-Feb_out     1.14     0.606         0.505            0.769
##  4 3m_Jan-Mar_out     0.738    0.565         0.266            0.380
##  5 3m_Feb-Apr_out     0.500    0.432         0.250            0.241
##  6 1m_Nov_out         0.668    0.437         0.304            0.264
##  7 1m_Dec_out         1.14     0.586         0.713            0.980
##  8 1m_Jan_out         0.959    0.515         0.257            0.476
##  9 1m_Feb_out         0.494    0.326         0.237            0.233
## 10 1m_Mar_out         0.431    0.346         0.190            0.217
## 11 1m_Apr_out         0.720    0.408         0.446            0.462
## # … with 6 more variables: MAPE_add_mDOW.hw_m__DOW <dbl>,
## #   MAPE_add.hw_a__dpr <dbl>, MAPE_add_mDOW.hw_a__dpr <dbl>,
## #   MAPE_add_mDOW.hw_m__dpr <dbl>, MAPE_nn <dbl>, MAPE_glm_st <dbl>

essem_result_W_MASE <- essem_result_W[names(essem_result_W) %like% "MASE" | names(essem_result_W) == "forecast_period"]
essem_result_W_MASE

## # A tibble: 11 x 11
##    forecast_period MASE_add MASE_mul MASE_add_mDOW MASE_add.hw_a_D…
##    <fct>              <dbl>    <dbl>         <dbl>            <dbl>
##  1 6m_Nov-Apr_out     1.47     1.49          0.806            0.950
##  2 3m_Nov-Jan_out     1.43     1.24          0.749            0.905
##  3 3m_Dec-Feb_out     1.61     1.63          0.836            1.16 
##  4 3m_Jan-Mar_out     1.67     2.48          0.890            1.04 
##  5 3m_Feb-Apr_out     1.25     1.79          0.909            0.812
##  6 1m_Nov_out         1.00     1.06          0.558            0.444
##  7 1m_Dec_out         1.08     0.889         0.719            0.938
##  8 1m_Jan_out         1.60     1.67          0.524            0.870
##  9 1m_Feb_out         1.58     1.73          1.06             1.03 
## 10 1m_Mar_out         1.11     1.42          0.699            0.757
## 11 1m_Apr_out         0.708    0.875         0.549            0.461
## # … with 6 more variables: MASE_add_mDOW.hw_m__DOW <dbl>,
## #   MASE_add.hw_a__dpr <dbl>, MASE_add_mDOW.hw_a__dpr <dbl>,
## #   MASE_add_mDOW.hw_m__dpr <dbl>, MASE_nn <dbl>, MASE_glm_st <dbl>